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

Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

This commit is contained in:
Tiago Gomes 2013-04-04 16:20:18 +01:00
parent a2e54a235a 633a56647e
commit b13a8b73a1
144 changed files with 1939 additions and 2108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
BEAM/eam_am.c
View File

@ -1428,6 +1428,7 @@ static void *OpAddress[]= {
&&p_db_ref,
&&p_primitive,
&&p_cut_by,
&&p_save_by,
&&p_succ,
&&p_predc,
&&p_plus,
@ -3536,6 +3537,7 @@ break_debug(contador);
p_db_ref:
p_primitive:
p_cut_by:
p_save_by:
p_succ:
p_predc:
p_plus:

21
BEAM/eamamasm.h
View File

@ -115,15 +115,16 @@
#define _p_db_ref (_std_base+8)
#define _p_primitive (_std_base+9)
#define _p_cut_by (_std_base+10)
#define _p_succ (_std_base+11)
#define _p_predc (_std_base+12)
#define _p_plus (_std_base+13)
#define _p_minus (_std_base+14)
#define _p_times (_std_base+15)
#define _p_div (_std_base+16)
#define _p_dif (_std_base+17)
#define _p_eq (_std_base+18)
#define _p_arg (_std_base+19)
#define _p_functor (_std_base+20)
#define _p_save_by (_std_base+11)
#define _p_succ (_std_base+12)
#define _p_predc (_std_base+13)
#define _p_plus (_std_base+14)
#define _p_minus (_std_base+15)
#define _p_times (_std_base+16)
#define _p_div (_std_base+17)
#define _p_dif (_std_base+18)
#define _p_eq (_std_base+19)
#define _p_arg (_std_base+20)
#define _p_functor (_std_base+21)

133
C/absmi.c
View File

@ -512,26 +512,6 @@ Term Yap_XREGS[MaxTemps]; /* 29 */
#include "arith2.h"
/*
I can creep if I am not a prolog builtin that has been called
by a prolog builtin,
exception: meta-calls
*/
static PredEntry *
creep_allowed(PredEntry *p, PredEntry *p0)
{
if (!p0)
return NULL;
if (p0 == PredMetaCall)
return p0;
if (!p0->ModuleOfPred &&
(!p ||
!p->ModuleOfPred ||
p->PredFlags & StandardPredFlag))
return NULL;
return p;
}
#ifdef COROUTINING
/*
Imagine we are interrupting the execution, say, because we have a spy
@ -857,7 +837,6 @@ Yap_absmi(int inp)
BOp(Ystop, l);
SET_ASP(YREG, E_CB*sizeof(CELL));
/* make sure ASP is initialised */
Yap_StartSlots( PASS_REGS1 );
saveregs();
#if PUSH_REGS
@ -2869,11 +2848,6 @@ Yap_absmi(int inp)
CreepFlag = CalculateStackGap();
goto fail;
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
PredEntry *ap = PREG->u.Osbpp.p;
SREG = (CELL *) ap;
goto creepc;
}
SREG = (CELL *) PREG->u.Osbpp.p;
if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
SET_ASP(YREG, PREG->u.Osbpp.s);
@ -3332,7 +3306,6 @@ Yap_absmi(int inp)
/* tell whether we can creep or not, this is hard because we will
lose the info RSN
*/
PP = creep_allowed((PredEntry*)SREG,PP);
BEGD(d0);
d0 = ((PredEntry *)(SREG))->ArityOfPE;
if (d0 == 0) {
@ -7365,6 +7338,7 @@ Yap_absmi(int inp)
struct DB_TERM *exp = EX;
EX = NULL;
Yap_JumpToEnv(Yap_PopTermFromDB(exp));
SREG = NULL;
}
if (!SREG) {
FAIL();
@ -9402,7 +9376,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9447,7 +9421,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9488,7 +9462,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9536,7 +9510,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9580,7 +9554,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9625,7 +9599,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_minus(MkIntegerTerm(d1),Yap_Eval(d0));
d0 = p_minus(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9666,7 +9640,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9714,7 +9688,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_minus(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_minus(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9754,11 +9728,11 @@ Yap_absmi(int inp)
times_vv_nvar_nvar:
/* d0 and d1 are where I want them */
if (IsIntTerm(d0) && IsIntTerm(d1)) {
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1));
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS);
}
else {
saveregs();
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9799,11 +9773,11 @@ Yap_absmi(int inp)
{
Int d1 = PREG->u.xxn.c;
if (IsIntTerm(d0)) {
d0 = times_int(IntOfTerm(d0), d1);
d0 = times_int(IntOfTerm(d0), d1 PASS_REGS);
}
else {
saveregs();
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9840,11 +9814,11 @@ Yap_absmi(int inp)
times_y_vv_nvar_nvar:
/* d0 and d1 are where I want them */
if (IsIntTerm(d0) && IsIntTerm(d1)) {
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1));
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS);
}
else {
saveregs();
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9888,11 +9862,11 @@ Yap_absmi(int inp)
{
Int d1 = PREG->u.yxn.c;
if (IsIntTerm(d0)) {
d0 = times_int(IntOfTerm(d0), d1);
d0 = times_int(IntOfTerm(d0), d1 PASS_REGS);
}
else {
saveregs();
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9943,7 +9917,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -9988,7 +9962,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1));
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10032,7 +10006,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0));
d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS);
if (d0 == 0L) {
saveregs();
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
@ -10079,7 +10053,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10127,7 +10101,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1));
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10174,7 +10148,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_div(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_div(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10219,7 +10193,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10264,7 +10238,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10305,7 +10279,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10353,7 +10327,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10398,7 +10372,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10443,7 +10417,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
if (d0 == 0L) {
saveregs();
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
@ -10483,7 +10457,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10531,7 +10505,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10575,11 +10549,11 @@ Yap_absmi(int inp)
if (i2 < 0)
d0 = MkIntegerTerm(SLR(IntOfTerm(d0), -i2));
else
d0 = do_sll(IntOfTerm(d0),i2);
d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS);
}
else {
saveregs();
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
if (d0 == 0L) {
@ -10620,11 +10594,11 @@ Yap_absmi(int inp)
{
Int d1 = PREG->u.xxn.c;
if (IsIntTerm(d0)) {
d0 = do_sll(IntOfTerm(d0), (Int)d1);
d0 = do_sll(IntOfTerm(d0), (Int)d1 PASS_REGS);
}
else {
saveregs();
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
}
}
@ -10661,11 +10635,11 @@ Yap_absmi(int inp)
if (i2 < 0)
d0 = MkIntegerTerm(SLR(d1, -i2));
else
d0 = do_sll(d1,i2);
d0 = do_sll(d1,i2 PASS_REGS);
}
else {
saveregs();
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
}
}
@ -10706,11 +10680,11 @@ Yap_absmi(int inp)
if (i2 < 0)
d0 = MkIntegerTerm(SLR(IntOfTerm(d0), -i2));
else
d0 = do_sll(IntOfTerm(d0),i2);
d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS);
}
else {
saveregs();
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
if (d0 == 0L) {
@ -10754,11 +10728,11 @@ Yap_absmi(int inp)
{
Int d1 = PREG->u.yxn.c;
if (IsIntTerm(d0)) {
d0 = do_sll(IntOfTerm(d0), Yap_Eval(d1));
d0 = do_sll(IntOfTerm(d0), Yap_Eval(d1) PASS_REGS);
}
else {
saveregs();
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
}
}
@ -10799,11 +10773,11 @@ Yap_absmi(int inp)
if (i2 < 0)
d0 = MkIntegerTerm(SLR(d1, -i2));
else
d0 = do_sll(d1,i2);
d0 = do_sll(d1,i2 PASS_REGS);
}
else {
saveregs();
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(0));
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(0) PASS_REGS);
setregs();
}
}
@ -10845,13 +10819,13 @@ Yap_absmi(int inp)
if (IsIntTerm(d0) && IsIntTerm(d1)) {
Int i2 = IntOfTerm(d1);
if (i2 < 0)
d0 = do_sll(IntOfTerm(d0), -i2);
d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS);
else
d0 = MkIntTerm(SLR(IntOfTerm(d0), i2));
}
else {
saveregs();
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
if (d0 == 0L) {
@ -10896,7 +10870,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -10931,13 +10905,13 @@ Yap_absmi(int inp)
if (IsIntTerm(d0)) {
Int i2 = IntOfTerm(d0);
if (i2 < 0)
d0 = do_sll(d1, -i2);
d0 = do_sll(d1, -i2 PASS_REGS);
else
d0 = MkIntegerTerm(SLR(d1, i2));
}
else {
saveregs();
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
}
}
@ -10976,13 +10950,13 @@ Yap_absmi(int inp)
if (IsIntTerm(d0) && IsIntTerm(d1)) {
Int i2 = IntOfTerm(d1);
if (i2 < 0)
d0 = do_sll(IntOfTerm(d0), -i2);
d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS);
else
d0 = MkIntTerm(SLR(IntOfTerm(d0), i2));
}
else {
saveregs();
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1));
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
}
BEGP(pt0);
@ -11030,7 +11004,7 @@ Yap_absmi(int inp)
}
else {
saveregs();
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1));
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
@ -11067,13 +11041,13 @@ Yap_absmi(int inp)
if (IsIntTerm(d0)) {
Int i2 = IntOfTerm(d0);
if (i2 < 0)
d0 = do_sll(d1, -i2);
d0 = do_sll(d1, -i2 PASS_REGS);
else
d0 = MkIntegerTerm(SLR(d1, i2));
}
else {
saveregs();
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0));
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
setregs();
}
}
@ -13458,7 +13432,6 @@ Yap_absmi(int inp)
}
PP = NULL;
SREG = (CELL *) pen;
fprintf(stderr,"Here I was\n");
ASP = ENV_YREG;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);

4
C/adtdefs.c
View File

@ -852,7 +852,6 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
p->FunctorOfPred = fe;
WRITE_UNLOCK(fe->FRWLock);
{
CACHE_REGS
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_FUNC);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_FUNC);
@ -966,7 +965,6 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
p->FunctorOfPred = (Functor)AbsAtom(ae);
WRITE_UNLOCK(ae->ARWLock);
{
CACHE_REGS
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_ATOM);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_ATOM);
@ -1057,8 +1055,10 @@ Yap_GetValue(Atom a)
if (IsApplTerm(out)) {
Functor f = FunctorOfTerm(out);
if (f == FunctorDouble) {
CACHE_REGS
out = MkFloatTerm(FloatOfTerm(out));
} else if (f == FunctorLongInt) {
CACHE_REGS
out = MkLongIntTerm(LongIntOfTerm(out));
}
#ifdef USE_GMP

5
C/amasm.c
View File

@ -2056,10 +2056,7 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
save_machine_regs();
siglongjmp(cip->CompilerBotch,2);
}
{
CACHE_REGS
Yap_inform_profiler_of_clause(newcp, (char *)(newcp)+size, ap, GPROF_INDEX);
}
Yap_inform_profiler_of_clause(newcp, (char *)(newcp)+size, ap, GPROF_INDEX);
Yap_LUIndexSpace_CP += size;
#ifdef DEBUG
Yap_NewCps++;

25
C/arith1.c
View File

@ -29,7 +29,7 @@ static char SccsId[] = "%W% %G%";
#include "eval.h"
static Term
float_to_int(Float v)
float_to_int(Float v USES_REGS)
{
#if USE_GMP
Int i = (Int)v;
@ -44,7 +44,7 @@ float_to_int(Float v)
#endif
}
#define RBIG_FL(v) return(float_to_int(v))
#define RBIG_FL(v) return(float_to_int(v PASS_REGS))
typedef struct init_un_eval {
char *OpName;
@ -118,7 +118,7 @@ double my_rint(double x)
#endif
static Int
msb(Int inp) /* calculate the most significant bit for an integer */
msb(Int inp USES_REGS) /* calculate the most significant bit for an integer */
{
/* the obvious solution: do it by using binary search */
Int out = 0;
@ -141,7 +141,7 @@ msb(Int inp) /* calculate the most significant bit for an integer */
}
static Int
lsb(Int inp) /* calculate the least significant bit for an integer */
lsb(Int inp USES_REGS) /* calculate the least significant bit for an integer */
{
/* the obvious solution: do it by using binary search */
Int out = 0;
@ -165,7 +165,7 @@ lsb(Int inp) /* calculate the least significant bit for an integer */
}
static Int
popcount(Int inp) /* calculate the least significant bit for an integer */
popcount(Int inp USES_REGS) /* calculate the least significant bit for an integer */
{
/* the obvious solution: do it by using binary search */
Int c = 0, j = 0, m = ((CELL)1);
@ -185,7 +185,7 @@ popcount(Int inp) /* calculate the least significant bit for an integer */
}
static Term
eval1(Int fi, Term t) {
eval1(Int fi, Term t USES_REGS) {
arith1_op f = fi;
switch (f) {
case op_uplus:
@ -586,7 +586,7 @@ eval1(Int fi, Term t) {
case op_msb:
switch (ETypeOfTerm(t)) {
case long_int_e:
RINT(msb(IntegerOfTerm(t)));
RINT(msb(IntegerOfTerm(t) PASS_REGS));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t));
case big_int_e:
@ -599,7 +599,7 @@ eval1(Int fi, Term t) {
case op_lsb:
switch (ETypeOfTerm(t)) {
case long_int_e:
RINT(lsb(IntegerOfTerm(t)));
RINT(lsb(IntegerOfTerm(t) PASS_REGS));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "lsb(%f)", FloatOfTerm(t));
case big_int_e:
@ -612,7 +612,7 @@ eval1(Int fi, Term t) {
case op_popcount:
switch (ETypeOfTerm(t)) {
case long_int_e:
RINT(popcount(IntegerOfTerm(t)));
RINT(popcount(IntegerOfTerm(t) PASS_REGS));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount(%f)", FloatOfTerm(t));
case big_int_e:
@ -699,7 +699,8 @@ eval1(Int fi, Term t) {
Term Yap_eval_unary(Int f, Term t)
{
return eval1(f,t);
CACHE_REGS
return eval1(f,t PASS_REGS);
}
static InitUnEntry InitUnTab[] = {
@ -758,7 +759,7 @@ p_unary_is( USES_REGS1 )
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top), Deref(ARG3));
Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top PASS_REGS), Deref(ARG3));
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);
@ -781,7 +782,7 @@ p_unary_is( USES_REGS1 )
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval1(p->FOfEE, top),Deref(ARG3))))
if (!(out=Yap_FoundArithError(eval1(p->FOfEE, top PASS_REGS),Deref(ARG3))))
return FALSE;
return Yap_unify_constant(ARG1,out);
}

85
C/arith2.c
View File

@ -37,7 +37,7 @@ typedef struct init_un_eval {
static Term
p_mod(Term t1, Term t2) {
p_mod(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
@ -51,12 +51,7 @@ p_mod(Term t1, Term t2) {
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1);
if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"// /2 with %d and %d", i1, i2);
#endif
return MkIntTerm(0);
}
mod = i1%i2;
if (mod && (mod ^ i2) < 0)
@ -102,7 +97,7 @@ p_mod(Term t1, Term t2) {
}
static Term
p_div2(Term t1, Term t2) {
p_div2(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
@ -168,7 +163,7 @@ p_div2(Term t1, Term t2) {
}
static Term
p_rem(Term t1, Term t2) {
p_rem(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
@ -181,12 +176,7 @@ p_rem(Term t1, Term t2) {
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1);
if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"rem/2 with %d and %d", i1, i2);
#endif
return MkIntTerm(0);
}
RINT(i1%i2);
}
@ -225,7 +215,7 @@ p_rem(Term t1, Term t2) {
static Term
p_rdiv(Term t1, Term t2) {
p_rdiv(Term t1, Term t2 USES_REGS) {
#ifdef USE_GMP
switch (ETypeOfTerm(t1)) {
case (CELL)double_e:
@ -276,7 +266,7 @@ p_rdiv(Term t1, Term t2) {
Floating point division: /
*/
static Term
p_fdiv(Term t1, Term t2)
p_fdiv(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
@ -348,7 +338,7 @@ p_fdiv(Term t1, Term t2)
xor #
*/
static Term
p_xor(Term t1, Term t2)
p_xor(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
@ -392,7 +382,7 @@ p_xor(Term t1, Term t2)
atan2: arc tangent x/y
*/
static Term
p_atan2(Term t1, Term t2)
p_atan2(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
@ -471,7 +461,7 @@ p_atan2(Term t1, Term t2)
power: x^y
*/
static Term
p_power(Term t1, Term t2)
p_power(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
@ -587,7 +577,7 @@ ipow(Int x, Int p)
power: x^y
*/
static Term
p_exp(Term t1, Term t2)
p_exp(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
@ -679,7 +669,7 @@ p_exp(Term t1, Term t2)
}
static Int
gcd(Int m11,Int m21)
gcd(Int m11,Int m21 USES_REGS)
{
/* Blankinship algorithm, provided by Miguel Filgueiras */
Int m12=1, m22=0, k;
@ -729,7 +719,7 @@ Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */
module gcd
*/
static Term
p_gcd(Term t1, Term t2)
p_gcd(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
@ -741,7 +731,7 @@ p_gcd(Term t1, Term t2)
i1 = (i1 >= 0 ? i1 : -i1);
i2 = (i2 >= 0 ? i2 : -i2);
RINT(gcd(i1,i2));
RINT(gcd(i1,i2 PASS_REGS));
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
@ -967,56 +957,57 @@ p_max(Term t1, Term t2)
}
static Term
eval2(Int fi, Term t1, Term t2) {
eval2(Int fi, Term t1, Term t2 USES_REGS) {
arith2_op f = fi;
switch (f) {
case op_plus:
return p_plus(t1, t2);
return p_plus(t1, t2 PASS_REGS);
case op_minus:
return p_minus(t1, t2);
return p_minus(t1, t2 PASS_REGS);
case op_times:
return p_times(t1, t2);
return p_times(t1, t2 PASS_REGS);
case op_div:
return p_div(t1, t2);
return p_div(t1, t2 PASS_REGS);
case op_idiv:
return p_div2(t1, t2);
return p_div2(t1, t2 PASS_REGS);
case op_and:
return p_and(t1, t2);
return p_and(t1, t2 PASS_REGS);
case op_or:
return p_or(t1, t2);
return p_or(t1, t2 PASS_REGS);
case op_sll:
return p_sll(t1, t2);
return p_sll(t1, t2 PASS_REGS);
case op_slr:
return p_slr(t1, t2);
return p_slr(t1, t2 PASS_REGS);
case op_mod:
return p_mod(t1, t2);
return p_mod(t1, t2 PASS_REGS);
case op_rem:
return p_rem(t1, t2);
return p_rem(t1, t2 PASS_REGS);
case op_fdiv:
return p_fdiv(t1, t2);
return p_fdiv(t1, t2 PASS_REGS);
case op_xor:
return p_xor(t1, t2);
return p_xor(t1, t2 PASS_REGS);
case op_atan2:
return p_atan2(t1, t2);
return p_atan2(t1, t2 PASS_REGS);
case op_power:
return p_exp(t1, t2);
return p_exp(t1, t2 PASS_REGS);
case op_power2:
return p_power(t1, t2);
return p_power(t1, t2 PASS_REGS);
case op_gcd:
return p_gcd(t1, t2);
return p_gcd(t1, t2 PASS_REGS);
case op_min:
return p_min(t1, t2);
case op_max:
return p_max(t1, t2);
case op_rdiv:
return p_rdiv(t1, t2);
return p_rdiv(t1, t2 PASS_REGS);
}
RERROR();
}
Term Yap_eval_binary(Int f, Term t1, Term t2)
{
return eval2(f,t1,t2);
CACHE_REGS
return eval2(f,t1,t2 PASS_REGS);
}
static InitBinEntry InitBinTab[] = {
@ -1068,7 +1059,7 @@ p_binary_is( USES_REGS1 )
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2 PASS_REGS), 0L);
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);
@ -1091,7 +1082,7 @@ p_binary_is( USES_REGS1 )
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2 PASS_REGS), 0L)))
return FALSE;
return Yap_unify_constant(ARG1,out);
}
@ -1115,7 +1106,7 @@ do_arith23(arith2_op op USES_REGS)
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
if (!(out=Yap_FoundArithError(eval2(op, t1, t2), 0L)))
if (!(out=Yap_FoundArithError(eval2(op, t1, t2 PASS_REGS), 0L)))
return FALSE;
return Yap_unify_constant(ARG3,out);
}

34
C/bignum.c
View File

@ -320,6 +320,7 @@ Yap_MkULLIntTerm(YAP_ULONG_LONG n)
/* try to scan it as a bignum */
mpz_init_set_str (new, tmp, 10);
if (mpz_fits_slong_p(new)) {
CACHE_REGS
return MkIntegerTerm(mpz_get_si(new));
}
t = Yap_MkBigIntTerm(new);
@ -346,6 +347,38 @@ p_is_bignum( USES_REGS1 )
#endif
}
static Int
p_nb_set_bit( USES_REGS1 )
{
#ifdef USE_GMP
Term t = Deref(ARG1);
Term ti = Deref(ARG2);
Int i;
if (!(
IsNonVarTerm(t) &&
IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorBigInt &&
RepAppl(t)[1] == BIG_INT
))
return FALSE;
if (!IsIntegerTerm(ti)) {
return FALSE;
}
if (!IsIntegerTerm(ti)) {
return FALSE;
}
i = IntegerOfTerm(ti);
if (i < 0) {
return FALSE;
}
Yap_gmp_set_bit(i, t);
return TRUE;
#else
return FALSE;
#endif
}
static Int
p_has_bignums( USES_REGS1 )
{
@ -560,4 +593,5 @@ Yap_InitBigNums(void)
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
Yap_InitCPred("rational", 3, p_rational, 0);
Yap_InitCPred("rational", 1, p_is_rational, SafePredFlag);
Yap_InitCPred("nb_set_bit", 2, p_nb_set_bit, SafePredFlag);
}

132
C/c_interface.c
View File

@ -462,6 +462,7 @@ X_API Term STD_PROTO(YAP_NBufferToDiffList, (char *, Term, size_t));
X_API Term STD_PROTO(YAP_WideBufferToDiffList, (wchar_t *, Term));
X_API Term STD_PROTO(YAP_NWideBufferToDiffList, (wchar_t *, Term, size_t));
X_API void STD_PROTO(YAP_Error,(int, Term, char *, ...));
X_API Int STD_PROTO(YAP_RunPredicate,(PredEntry *, Term *));
X_API Int STD_PROTO(YAP_RunGoal,(Term));
X_API Int STD_PROTO(YAP_RunGoalOnce,(Term));
X_API int STD_PROTO(YAP_RestartGoal,(void));
@ -472,7 +473,7 @@ X_API int STD_PROTO(YAP_LeaveGoal,(int, YAP_dogoalinfo *));
X_API int STD_PROTO(YAP_GoalHasException,(Term *));
X_API void STD_PROTO(YAP_ClearExceptions,(void));
X_API int STD_PROTO(YAP_ContinueGoal,(void));
X_API void STD_PROTO(YAP_PruneGoal,(void));
X_API void STD_PROTO(YAP_PruneGoal,(YAP_dogoalinfo *));
X_API IOSTREAM *STD_PROTO(YAP_TermToStream,(Term));
X_API IOSTREAM *STD_PROTO(YAP_InitConsult,(int, char *));
X_API void STD_PROTO(YAP_EndConsult,(IOSTREAM *));
@ -737,6 +738,7 @@ YAP_IsCompoundTerm(Term t)
X_API Term
YAP_MkIntTerm(Int n)
{
CACHE_REGS
Term I;
BACKUP_H();
@ -853,6 +855,7 @@ YAP_BlobOfTerm(Term t)
X_API Term
YAP_MkFloatTerm(double n)
{
CACHE_REGS
Term t;
BACKUP_H();
@ -1787,7 +1790,6 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top)
PP = pe;
ctx->control = FRG_CUTTED;
ctx->engine = NULL; //(PL_local_data *)Yap_regp;
ctx->context = NULL;
if (pe->PredFlags & CArgsPredFlag) {
val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
} else {
@ -2238,12 +2240,6 @@ YAP_Error(int myerrno, Term t, char *buf,...)
Yap_Error(myerrno,t,tmpbuf);
}
static int myputc (wchar_t ch)
{
putc(ch,stderr);
return ch;
}
X_API PredEntry *
YAP_FunctorToPred(Functor func)
{
@ -2272,36 +2268,15 @@ YAP_AtomToPredInModule(Atom at, Term mod)
static int
run_emulator(YAP_dogoalinfo *dgi)
run_emulator(YAP_dogoalinfo *dgi USES_REGS)
{
CACHE_REGS
choiceptr myB;
int out;
BACKUP_MACHINE_REGS();
LOCAL_PrologMode = UserMode;
out = Yap_absmi(0);
LOCAL_PrologMode = UserCCallMode;
myB = (choiceptr)(LCL0-dgi->b);
CP = myB->cp_cp;
if (!out ) {
/* recover stack */
/* on failed computations */
TR = B->cp_tr;
H = B->cp_h;
#ifdef DEPTH_LIMIT
DEPTH = B->cp_depth = DEPTH;
#endif /* DEPTH_LIMIT */
YENV = ENV = B->cp_env;
ASP = (CELL *)(B+1);
Yap_PopSlots( PASS_REGS1 );
B = B->cp_b;
HB = B->cp_h;
} else {
Yap_StartSlots( PASS_REGS1 );
}
P = dgi->p;
RECOVER_MACHINE_REGS();
if (out)
Yap_StartSlots(PASS_REGS1);
return out;
}
@ -2309,39 +2284,15 @@ X_API int
YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
{
CACHE_REGS
UInt i;
choiceptr myB;
int out;
BACKUP_MACHINE_REGS();
dgi->p = P;
ptr--;
i = pe->ArityOfPE;
while (i>0) {
XREGS[i] = ptr[i];
i--;
}
dgi->cp = CP;
P = pe->CodeOfPred;
/* create a choice-point to be tag new goal */
myB = (choiceptr)ASP;
myB--;
dgi->b = LCL0-(CELL *)myB;
myB->cp_tr = TR;
myB->cp_h = HB = H;
myB->cp_b = B;
#ifdef DEPTH_LIMIT
myB->cp_depth = DEPTH;
#endif /* DEPTH_LIMIT */
myB->cp_cp = CP;
myB->cp_ap = NOCODE;
myB->cp_env = ENV;
CP = YESCODE;
B = myB;
HB = H;
ASP = YENV = (CELL *)B;
Yap_PopSlots( PASS_REGS1 );
YENV[E_CB] = Unsigned (B);
out = run_emulator(dgi);
Yap_PrepGoal(pe->ArityOfPE, ptr, B PASS_REGS);
dgi->b = LCL0-(CELL*)B;
out = run_emulator(dgi PASS_REGS);
RECOVER_MACHINE_REGS();
return out;
}
@ -2361,7 +2312,10 @@ YAP_RetryGoal(YAP_dogoalinfo *dgi)
return FALSE;
}
P = FAILCODE;
out = run_emulator(dgi);
/* make sure we didn't leave live slots when we backtrack */
ASP = (CELL *)B;
Yap_PopSlots( PASS_REGS1 );
out = run_emulator(dgi PASS_REGS);
RECOVER_MACHINE_REGS();
return out;
}
@ -2400,15 +2354,25 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
Yap_TrimTrail();
}
/* recover local stack */
ASP = (CELL *)(B+1);
Yap_PopSlots( PASS_REGS1 );
#ifdef DEPTH_LIMIT
DEPTH= ENV[E_DEPTH];
#endif
/* make sure we prune C-choicepoints */
if (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
B = B->cp_b;
HB = B->cp_h;
ENV = (CELL *)(ENV[E_E]);
/* ASP should be set to the top of the local stack when we
did the call */
ASP = B->cp_env;
Yap_PopSlots(PASS_REGS1);
/* YENV should be set to the current environment */
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
B = B->cp_b;
//SET_BB(B);
HB = PROTECT_FROZEN_H(B);
CP = dgi->cp;
P = dgi->p;
RECOVER_MACHINE_REGS();
return TRUE;
@ -2645,12 +2609,13 @@ YAP_ContinueGoal(void)
}
X_API void
YAP_PruneGoal(void)
YAP_PruneGoal(YAP_dogoalinfo *gi)
{
CACHE_REGS
BACKUP_B();
BACKUP_B();
while (B->cp_ap != NOCODE) {
choiceptr myB = (choiceptr)(LCL0-gi->b);
while (B != myB) {
/* make sure we prune C-choicepoints */
if (POP_CHOICE_POINT(B->cp_b))
{
@ -2661,9 +2626,6 @@ YAP_PruneGoal(void)
B = B->cp_b;
}
Yap_TrimTrail();
/* make sure that we do not destroy the guard choice-point */
if (Yap_op_from_opcode(B->cp_ap->opc) != _Nstop)
B = B->cp_b;
RECOVER_B();
}
@ -3278,30 +3240,31 @@ X_API int
YAP_Reset(void)
{
CACHE_REGS
int res = TRUE;
#ifndef THREADS
int worker_id = 0;
#endif
BACKUP_MACHINE_REGS();
YAP_ClearExceptions();
/* first, backtrack to the root */
if (B != NULL) {
while (B->cp_b != NULL)
B = B->cp_b;
while (B->cp_b) {
B = B->cp_b;
P = FAILCODE;
if (Yap_exec_absmi(0) != 0) {
GLOBAL_Initialised = TRUE;
Yap_InitYaamRegs( worker_id );
RECOVER_MACHINE_REGS();
return FALSE;
}
res = Yap_exec_absmi(0);
}
/* reinitialise the engine */
// Yap_InitYaamRegs( worker_id );
GLOBAL_Initialised = TRUE;
ENV = LCL0;
ASP = (CELL *)B;
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
CurSlot = 0;
Yap_StartSlots( PASS_REGS1 );
P = CP = YESCODE;
RECOVER_MACHINE_REGS();
return(TRUE);
return res;
}
X_API void
@ -3773,6 +3736,7 @@ YAP_CloseList(Term t0, Term tail)
X_API int
YAP_IsAttVar(Term t)
{
CACHE_REGS
t = Deref(t);
if (!IsVarTerm(t))
return FALSE;
@ -3782,6 +3746,7 @@ YAP_IsAttVar(Term t)
X_API Term
YAP_AttsOfVar(Term t)
{
CACHE_REGS
attvar_record *attv;
t = Deref(t);
@ -4062,6 +4027,7 @@ YAP_TagOfTerm(Term t)
if (IsVarTerm(t)) {
CELL *pt = VarOfTerm(t);
if (IsUnboundVar(pt)) {
CACHE_REGS
if (IsAttVar(pt))
return YAP_TAG_ATT;
return YAP_TAG_UNBOUND;

9
C/cdmgr.c
View File

@ -2841,7 +2841,7 @@ p_rmspy( USES_REGS1 )
return FALSE;
}
#if THREADS
if (!(pred->PredFlags & ThreadLocalPredFlag)) {
if (pred->PredFlags & ThreadLocalPredFlag) {
pred->OpcodeOfPred = Yap_opcode(_thread_local);
pred->PredFlags ^= SpiedPredFlag;
UNLOCKPE(39,pred);
@ -4910,6 +4910,7 @@ replace_integer(Term orig, UInt new)
return MkIntTerm(new);
/* should create an old integer */
if (!IsApplTerm(orig)) {
CACHE_REGS
Yap_Error(SYSTEM_ERROR,orig,"%uld-->%uld where it should increase",(unsigned long int)IntegerOfTerm(orig),(unsigned long int)new);
return MkIntegerTerm(new);
}
@ -5288,8 +5289,6 @@ p_continue_static_clause( USES_REGS1 )
static void
add_code_in_lu_index(LogUpdIndex *cl, PredEntry *pp)
{
CACHE_REGS
char *code_end = (char *)cl + cl->ClSize;
Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_LU_INDEX);
cl = cl->ChildIndex;
@ -5302,7 +5301,6 @@ add_code_in_lu_index(LogUpdIndex *cl, PredEntry *pp)
static void
add_code_in_static_index(StaticIndex *cl, PredEntry *pp)
{
CACHE_REGS
char *code_end = (char *)cl + cl->ClSize;
Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_STATIC_INDEX);
cl = cl->ChildIndex;
@ -5315,7 +5313,6 @@ add_code_in_static_index(StaticIndex *cl, PredEntry *pp)
static void
add_code_in_pred(PredEntry *pp) {
CACHE_REGS
yamop *clcode;
PELOCK(49,pp);
@ -5387,7 +5384,6 @@ add_code_in_pred(PredEntry *pp) {
void
Yap_dump_code_area_for_profiler(void) {
CACHE_REGS
ModEntry *me = CurrentModules;
while (me) {
@ -5667,6 +5663,7 @@ p_cpc_info( USES_REGS1 )
PredEntry *pe;
yamop *ipc = (yamop *)IntegerOfTerm(Deref(ARG1));
printf("ipc = %p %p\n", ipc, PREVOP(ipc,Osbpp));
pe = PREVOP(ipc,Osbpp)->u.Osbpp.p0;
return UnifyPredInfo(pe, 2 PASS_REGS) &&
Yap_unify(ARG5,MkIntegerTerm(ClauseId(ipc,pe)));

16
C/compiler.c
View File

@ -916,6 +916,22 @@ c_test(Int Op, Term t1, compiler_struct *cglobs) {
CACHE_REGS
Term t = Deref(t1);
/* be caareful, has to be first occurrence */
if (Op == _save_by) {
if (!IsNewVar(t)) {
char s[32];
LOCAL_Error_TYPE = TYPE_ERROR_VARIABLE;
LOCAL_Error_Term = t;
LOCAL_ErrorMessage = LOCAL_ErrorSay;
Yap_bip_name(Op, s);
sprintf(LOCAL_ErrorMessage, "compiling %s/2 on bound variable", s);
save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch,1);
}
c_var(t, save_b_flag, 1, 0, cglobs);
return;
}
if (!IsVarTerm(t) || IsNewVar(t)) {
Term tn = MkVarTerm();
c_eq(t, tn, cglobs);

9
C/computils.c
View File

@ -331,6 +331,9 @@ bip_name(Int op, char *s)
case _cut_by:
strcpy(s,"cut_by");
break;
case _save_by:
strcpy(s,"save_by");
break;
case _db_ref:
strcpy(s,"db_ref");
break;
@ -468,6 +471,7 @@ ShowOp (char *f, struct PSEUDO *cpc)
case 'b':
/* write a variable bitmap for a call */
{
CACHE_REGS
int max = arg/(8*sizeof(CELL)), i;
CELL *ptr = cptr;
for (i = 0; i <= max; i++) {
@ -487,7 +491,10 @@ ShowOp (char *f, struct PSEUDO *cpc)
}
break;
case 'd':
Yap_DebugPlWrite (MkIntegerTerm (arg));
{
CACHE_REGS
Yap_DebugPlWrite (MkIntegerTerm (arg));
}
break;
case 'z':
Yap_DebugPlWrite (MkIntTerm (cpc->rnd3));

11
C/dbase.c
View File

@ -1893,7 +1893,6 @@ record_lu(PredEntry *pe, Term t, int position)
return NULL;
}
{
CACHE_REGS
Yap_inform_profiler_of_clause(cl, (char *)cl+cl->ClSize, pe, GPROF_NEW_LU_CLAUSE);
}
Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
@ -2382,6 +2381,7 @@ GetDBLUKey(PredEntry *ap)
{
PELOCK(63,ap);
if (ap->PredFlags & NumberDBPredFlag) {
CACHE_REGS
Int id = ap->src.IndxId;
UNLOCK(ap->PELock);
return MkIntegerTerm(id);
@ -2431,6 +2431,7 @@ UnifyDBKey(DBRef DBSP, PropFlags flags, Term t)
static int
UnifyDBNumber(DBRef DBSP, Term t)
{
CACHE_REGS
DBProp p = DBSP->Parent;
DBRef ref;
Int i = 1;
@ -4740,7 +4741,13 @@ p_instance( USES_REGS1 )
YENV = ASP;
YENV[E_CB] = (CELL) B;
P = cl->ClCode;
UNLOCK(ap->PELock);
#if defined(YAPOR) || defined(THREADS)
if (ap->PredFlags & ThreadLocalPredFlag) {
UNLOCK(ap->PELock);
} else {
PP = ap;
}
#endif
return TRUE;
}
}

4
C/errors.c
View File

@ -444,7 +444,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
tmpbuf[0] = '\0';
}
va_end (ap);
fprintf(stderr,"%% ERROR WITHIN ERROR: %s\n", tmpbuf);
fprintf(stderr,"%% ERROR WITHIN ERROR %d: %s\n", tmpbuf, LOCAL_CurrentError);
exit(1);
}
/* must do this here */
@ -485,6 +485,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
if (type == PURE_ABORT || LOCAL_PrologMode & BootMode) {
where = TermNil;
LOCAL_PrologMode &= ~AbortMode;
LOCAL_CurrentError = type;
LOCAL_PrologMode |= InErrorMode;
/* make sure failure will be seen at next port */
if (LOCAL_PrologMode & AsyncIntMode)
@ -499,6 +500,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
}
/* Exit Abort Mode, if we were there */
LOCAL_PrologMode &= ~AbortMode;
LOCAL_CurrentError = type;
LOCAL_PrologMode |= InErrorMode;
if (!(where = Yap_CopyTerm(where))) {
where = TermNil;

104
C/exec.c
View File

@ -165,8 +165,8 @@ do_execute(Term t, Term mod USES_REGS)
if (PRED_GOAL_EXPANSION_ALL) {
LOCK(LOCAL_SignalLock);
/* disable creeping when we do goal expansion */
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
CreepFlag = CalculateStackGap();
}
UNLOCK(LOCAL_SignalLock);
@ -337,8 +337,8 @@ do_execute_n(Term t, Term mod, unsigned int n USES_REGS)
if (PRED_GOAL_EXPANSION_ALL) {
LOCK(LOCAL_SignalLock);
/* disable creeping when we do goal expansion */
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
CreepFlag = CalculateStackGap();
}
UNLOCK(LOCAL_SignalLock);
@ -391,12 +391,16 @@ EnterCreepMode(Term t, Term mod USES_REGS) {
return do_execute(ARG1, mod PASS_REGS);
}
}
PP = PredMetaCall;
PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1));
if (mod) {
ARG1 = MkPairTerm(mod,t);
PP = PredCreep;
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) {
ARG1 = MkPairTerm(ArgOfTerm(1,t),ArgOfTerm(2,t));
} else {
ARG1 = MkPairTerm(TermProlog,t);
if (mod) {
ARG1 = MkPairTerm(mod,t);
} else {
ARG1 = MkPairTerm(TermProlog,t);
}
}
LOCK(LOCAL_SignalLock);
CreepFlag = CalculateStackGap();
@ -635,7 +639,8 @@ p_execute_clause( USES_REGS1 )
} else {
code = Yap_ClauseFromTerm(clt)->ClCode;
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL);
}
return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS);
@ -650,7 +655,7 @@ p_execute_in_mod( USES_REGS1 )
static Int
p_do_goal_expansion( USES_REGS1 )
{
Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL;
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
Int out = FALSE;
PredEntry *pe;
Term cmod = Deref(ARG2);
@ -658,7 +663,7 @@ p_do_goal_expansion( USES_REGS1 )
ARG2 = ARG3;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
@ -713,14 +718,14 @@ p_do_goal_expansion( USES_REGS1 )
static Int
p_do_term_expansion( USES_REGS1 )
{
Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL;
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
Int out = FALSE;
PredEntry *pe;
Term cmod = CurrentModule;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
@ -896,7 +901,8 @@ p_execute_nonstop( USES_REGS1 )
/* N = arity; */
/* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) {
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)
@ -1039,12 +1045,18 @@ p_execute_depth_limit( USES_REGS1 ) {
Term d = Deref(ARG2);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR,d,"depth_bound_call/2");
} else if (!IsIntTerm(d)) {
Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return(FALSE);
return FALSE;
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
DEPTH = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return FALSE;
}
} else {
DEPTH = MkIntTerm(IntegerOfTerm(d)*2);
}
DEPTH = MkIntTerm(IntOfTerm(d)*2);
return(p_execute( PASS_REGS1 ));
return p_execute( PASS_REGS1 );
}
#endif
@ -1120,8 +1132,8 @@ exec_absmi(int top USES_REGS)
}
static void
init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
void
Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS)
{
/* create an initial pseudo environment so that when garbage
collection is going up in the environment chain it doesn't get
@ -1162,8 +1174,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
#endif /* DEPTH_LIMIT */
YENV = ASP = (CELL *)B;
HB = H;
/* start with some slots so that we can use them */
Yap_StartSlots( PASS_REGS1 );
CP = YESCODE;
}
@ -1173,7 +1183,7 @@ do_goal(yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS)
choiceptr saved_b = B;
Int out;
init_stack(arity, pt, top, saved_b PASS_REGS);
Yap_PrepGoal(arity, pt, saved_b PASS_REGS);
P = (yamop *) CodeAdr;
S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */
@ -1767,13 +1777,9 @@ Yap_InitYaamRegs( int myworker_id )
#endif /* FROZEN_STACKS */
LOCK(REMOTE_SignalLock(myworker_id));
CreepFlag = CalculateStackGap();
UNLOCK(REMOTE_SignalLock(myworker_id));
EX = NULL;
init_stack(0, NULL, TRUE, NULL PASS_REGS);
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
CurSlot = 0;
Yap_StartSlots( PASS_REGS1 );
REMOTE_GlobalArena(myworker_id) = TermNil;
h0var = MkVarTerm();
#if defined(YAPOR) || defined(THREADS)
@ -1799,11 +1805,14 @@ Yap_InitYaamRegs( int myworker_id )
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL;
#endif
Yap_PrepGoal(0, NULL, NULL PASS_REGS);
Yap_StartSlots( PASS_REGS1 );
#ifdef TABLING
/* ensure that LOCAL_top_dep_fr is always valid */
if (REMOTE_top_dep_fr(myworker_id))
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
#endif
UNLOCK(REMOTE_SignalLock(myworker_id));
}
static Int
@ -1814,41 +1823,6 @@ p_uncaught_throw( USES_REGS1 )
return out;
}
static Int
p_creep_allowed( USES_REGS1 )
{
if (PP != NULL) {
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
} else {
UNLOCK(LOCAL_SignalLock);
}
return TRUE;
}
return FALSE;
}
static Int
p_debug_on( USES_REGS1 )
{
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
if (LOCAL_DebugOn)
return Yap_unify(MkAtomTerm(AtomTrue),ARG1);
else
return Yap_unify(MkAtomTerm(AtomFalse),ARG1);
}
if (t == MkAtomTerm(AtomTrue))
LOCAL_DebugOn = TRUE;
else
LOCAL_DebugOn = FALSE;
return TRUE;
}
Term
Yap_GetException(void)
{
@ -1936,13 +1910,14 @@ Yap_InitExecFs(void)
Yap_InitCPred("call_with_args", 9, p_execute_8, 0);
Yap_InitCPred("call_with_args", 10, p_execute_9, 0);
Yap_InitCPred("call_with_args", 11, p_execute_10, 0);
Yap_InitCPred("$debug_on", 1, p_debug_on, 0);
#ifdef DEPTH_LIMIT
Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
#endif
Yap_InitCPred("$execute0", 2, p_execute0, 0);
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, 0);
Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0);
Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0);
Yap_InitCPred("$current_choicepoint", 1, p_save_cp, 0);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("current_choice_point", 1, p_save_cp, 0);
Yap_InitCPred("current_choicepoint", 1, p_save_cp, 0);
@ -1956,7 +1931,6 @@ Yap_InitExecFs(void)
Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag);
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, p_cut_up_to_next_disjunction, SafePredFlag);
Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0);
Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0);
Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0);
Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, 0);
Yap_InitCPred("$reset_exception", 1, p_reset_exception, 0);

215
C/exo.c
View File

@ -40,50 +40,67 @@
#define MAX_ARITY 256
#define FNV32_PRIME 16777619
#define FNV64_PRIME ((UInt)1099511628211)
#define FNV32_OFFSET 2166136261
#define FNV64_OFFSET ((UInt)14695981039346656037)
/* Simple hash function:
first component is the base key.
hash0 spreads extensions coming from different elements.
spread over j quadrants.
*/
static UInt
HASH(UInt hash0, UInt j, CELL *cl, struct index_t *it)
static BITS32
HASH(UInt arity, CELL *cl, UInt bnds[], UInt sz)
{
Term t = cl[j];
UInt sz = it->hsize;
if (IsIntTerm(t))
return (17*(IntOfTerm(t) + (hash0+1)*j ) ) % sz;
return (17*(((UInt)AtomOfTerm(t)>>5) + (hash0+1)*j ) ) % sz;
UInt hash;
UInt j=0;
hash = FNV32_OFFSET;
while (j < arity) {
if (bnds[j]) {
unsigned char *i=(unsigned char*)(cl+j);
unsigned char *m=(unsigned char*)(cl+(j+1));
while (i < m) {
hash = hash ^ i[0];
hash = hash * FNV32_PRIME;
i++;
}
}
j++;
}
return hash;
}
static UInt
NEXT(UInt hash, Term t, UInt j, struct index_t *it)
static BITS32
NEXT(UInt hash)
{
return (hash+(j+1)*997) % (it->hsize);
return (hash*997);
}
/* search for matching elements */
static int
MATCH(CELL *clp, CELL *kvp, UInt j, struct index_t *it, UInt bnds[])
MATCH(CELL *clp, CELL *kvp, UInt arity, UInt bnds[])
{
if ((kvp - it->cls)%it->arity != j)
return FALSE;
do {
if ( bnds[j] && *clp != *kvp)
UInt j = 0;
while (j< arity) {
if ( bnds[j] && clp[j] != kvp[j])
return FALSE;
clp--;
kvp--;
} while (j-- != 0);
j++;
}
return TRUE;
}
static void
ADD_TO_TRY_CHAIN(CELL *kvp, CELL *cl, struct index_t *it)
{
UInt old = (kvp-it->cls)/it->arity;
UInt new = (cl-it->cls)/it->arity;
UInt *links = it->links;
UInt tmp = links[old]; /* points to the end of the chain */
BITS32 old = (kvp-it->cls)/it->arity;
BITS32 new = (cl-it->cls)/it->arity;
BITS32 *links = it->links;
BITS32 tmp = links[old]; /* points to the end of the chain */
if (!tmp) {
links[old] = links[new] = new;
@ -111,50 +128,33 @@ ADD_TO_TRY_CHAIN(CELL *kvp, CELL *cl, struct index_t *it)
* match ci..j ck..j -> find j = minarg(cij \= c2j)
* else
*/
static void
INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0, UInt bnds[])
static int
INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt bnds[])
{
UInt j = base;
CELL *kvp;
UInt hash;
BITS32 hash;
int coll_count = 0;
/* skip over argument */
while (!bnds[j]) {
j++;
}
/* j is the firs bound element */
/* check if we match */
hash = hash0 = HASH(hash0, j, cl, it);
//if (exo_write) printf("h=%ld j=%ld %lx\n", hash, j, cl[j]);
hash = HASH(arity, cl, bnds, it->hsize);
next:
/* loop to insert element */
kvp = it->key[hash];
kvp = EXO_OFFSET_TO_ADDRESS(it, it->key [hash % it->hsize]);
if (kvp == NULL) {
/* simple case, new entry */
it->nentries++;
it->key[hash] = cl+j;
return;
} else if (MATCH(cl+j, kvp, j, it, bnds)) {
/* collision */
UInt k;
CELL *target;
for (k =j+1, target = kvp+1; k < arity; k++,target++ ) {
if (bnds[k]) {
if (*target != cl[k]) {
/* found a new forking point */
// printf("j=%ld hash0=%ld cl[j]=%lx\n", j, hash0, cl[j]);
INSERT(cl, it, arity, k, hash0, bnds);
return;
}
}
}
it->key[hash % it->hsize ] = EXO_ADDRESS_TO_OFFSET(it, cl);
return TRUE;
} else if (MATCH(kvp, cl, arity, bnds)) {
it->ntrys++;
ADD_TO_TRY_CHAIN(kvp, cl, it);
return;
return TRUE;
} else {
coll_count++;
if (coll_count == 32)
return FALSE;
it->ncollisions++;
hash = NEXT(hash, cl[j], j, it);
// printf("#");
hash = NEXT(hash);
//if (exo_write) printf("N=%ld\n", hash);
goto next;
}
@ -165,45 +165,31 @@ LOOKUP(struct index_t *it, UInt arity, UInt j, UInt bnds[])
{
CACHE_REGS
CELL *kvp;
UInt hash, hash0 = 0;
BITS32 hash;
/* j is the firs bound element */
/* check if we match */
hash:
hash = hash0 = HASH(hash0, j, XREGS+1, it);
hash = HASH(arity, XREGS+1, bnds, it->hsize);
next:
/* loop to insert element */
kvp = it->key[hash];
kvp = EXO_OFFSET_TO_ADDRESS(it, it->key[hash % it->hsize]);
if (kvp == NULL) {
/* simple case, no element */
return FAILCODE;
} else if (MATCH(XREGS+(j+1), kvp, j, it, bnds)) {
/* found element */
UInt k;
CELL *target;
for (k =j+1, target = kvp+1; k < arity; k++ ) {
if (bnds[k]) {
if (*target != XREGS[k+1]) {
j = k;
goto hash;
}
}
target++;
}
S = target-arity;
} else if (MATCH(kvp, XREGS+1, arity, bnds)) {
S = kvp;
if (!it->is_key && it->links[(S-it->cls)/arity])
return it->code;
else
return NEXTOP(NEXTOP(it->code,lp),lp);
} else {
/* collision */
hash = NEXT(hash, XREGS[j+1], j, it);
hash = NEXT(hash);
goto next;
}
}
static void
static int
fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
{
UInt i;
@ -211,12 +197,13 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
CELL *cl = it->cls;
for (i=0; i < it->nels; i++) {
INSERT(cl, it, arity, 0, 0, bnds);
if (!INSERT(cl, it, arity, 0, bnds))
return FALSE;
cl += arity;
}
for (i=0; i < it->hsize; i++) {
if (it->key[i]) {
UInt offset = (it->key[i]-it->cls)/arity;
UInt offset = it->key[i]/arity;
UInt last = it->links[offset];
if (last) {
/* the chain used to point straight to the last, and the last back to the origibal first */
@ -225,6 +212,7 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
}
}
}
return TRUE;
}
static struct index_t *
@ -246,6 +234,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return NULL;
}
i->is_key = FALSE;
i->next = *ip;
i->prev = NULL;
i->nels = ncls;
@ -255,30 +244,63 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
i->is_key = FALSE;
i->hsize = 2*ncls;
if (count) {
if (!(base = (CELL *)Yap_AllocCodeSpace(sizeof(CELL)*(ncls+i->hsize)))) {
if (!(base = (CELL *)Yap_AllocCodeSpace(sizeof(BITS32)*(ncls+i->hsize)))) {
CACHE_REGS
save_machine_regs();
LOCAL_Error_Size = 3*ncls*sizeof(CELL);
LOCAL_Error_Size = sizeof(CELL)*(ncls+i->hsize);
LOCAL_ErrorMessage = "not enough space to generate indices";
Yap_FreeCodeSpace((void *)i);
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return NULL;
}
bzero(base, 3*sizeof(CELL)*ncls);
bzero(base, sizeof(CELL)*(ncls+i->hsize));
}
i->size = sizeof(CELL)*(ncls+i->hsize)+sz+sizeof(struct index_t);
i->key = (CELL **)base;
i->key = (CELL *)base;
i->links = (CELL *)(base+i->hsize);
i->ncollisions = i->nentries = i->ntrys = 0;
i->cls = (CELL *)((ADDR)ap->cs.p_code.FirstClause+2*sizeof(struct index_t *));
*ip = i;
if (count) {
fill_hash(bmap, i, bnds);
printf("entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
if (!i->ntrys) {
i->is_key = TRUE;
if (base != realloc(base, i->hsize*sizeof(CELL)))
while (count) {
if (!fill_hash(bmap, i, bnds)) {
size_t sz;
i->hsize += ncls;
if (i->is_key) {
sz = i->hsize*sizeof(BITS32);
} else {
sz = (ncls+i->hsize)*sizeof(BITS32);
}
if (base != realloc(base, sz))
return FALSE;
bzero(base, sz);
i->key = (CELL *)base;
i->links = (CELL *)(base+i->hsize);
i->ncollisions = i->nentries = i->ntrys = 0;
continue;
}
fprintf(stderr, "entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
if (!i->ntrys && !i->is_key) {
i->is_key = TRUE;
if (base != realloc(base, i->hsize*sizeof(BITS32)))
return FALSE;
}
/* our hash table is just too large */
if (( i->nentries+i->ncollisions )*10 < i->hsize) {
size_t sz;
i->hsize = ( i->nentries+i->ncollisions )*10;
if (i->is_key) {
sz = i->hsize*sizeof(BITS32);
} else {
sz = (ncls+i->hsize)*sizeof(BITS32);
}
if (base != realloc(base, sz))
return FALSE;
bzero(base, sz);
i->key = (CELL *)base;
i->links = (CELL *)(base+i->hsize);
i->ncollisions = i->nentries = i->ntrys = 0;
} else {
break;
}
}
ptr = (yamop *)(i+1);
@ -337,14 +359,11 @@ Yap_ExoLookup(PredEntry *ap USES_REGS)
}
while (i) {
if (i->is_key) {
if ((i->bmap & bmap) == i->bmap) {
break;
}
} else {
if (i->bmap == bmap) {
break;
}
// if (i->is_key && (i->bmap & bmap) == i->bmap) {
// break;
// }
if (i->bmap == bmap) {
break;
}
ip = &i->next;
i = i->next;
@ -362,9 +381,9 @@ CELL
Yap_NextExo(choiceptr cptr, struct index_t *it)
{
CACHE_REGS
CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]);
CELL offset = ADDRESS_TO_LINK(it,(CELL *)((CELL *)(B+1))[it->arity]);
CELL next = it->links[offset];
((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, next);
((CELL *)(B+1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, next);
S = it->cls+it->arity*offset;
return next;
}

3
C/globals.c
View File

@ -2121,6 +2121,7 @@ p_nb_beam_close( USES_REGS1 )
static void
PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to)
{
CACHE_REGS
UInt off = hsize, off2 = hsize;
Term toff, toff2;
@ -2166,6 +2167,7 @@ PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to)
static void
DelBeamMax(CELL *pt, CELL *pt2, UInt sz)
{
CACHE_REGS
UInt off = IntegerOfTerm(pt2[1]);
UInt indx = 0;
Term tk, ti, tv;
@ -2240,6 +2242,7 @@ DelBeamMax(CELL *pt, CELL *pt2, UInt sz)
static Term
DelBeamMin(CELL *pt, CELL *pt2, UInt sz)
{
CACHE_REGS
UInt off2 = IntegerOfTerm(pt[1]);
Term ov = pt2[3*off2+2]; /* return value */
UInt indx = 0;

28
C/gmp_support.c
View File

@ -132,6 +132,14 @@ Yap_gmp_add_int_big(Int i, Term t)
}
}
/* add i + b using temporary bigint new */
void
Yap_gmp_set_bit(Int i, Term t)
{
MP_INT *b = Yap_BigIntOfTerm(t);
mpz_setbit(b, i);
}
/* sub i - b using temporary bigint new */
Term
Yap_gmp_sub_int_big(Int i, Term t)
@ -384,6 +392,7 @@ Yap_gmp_sll_big_int(Term t, Int i)
} else {
mpz_init(&new);
if (i == Int_MIN) {
CACHE_REGS
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, MkIntegerTerm(i), "<</2");
}
mpz_fdiv_q_2exp(&new, b, -i);
@ -706,6 +715,7 @@ Yap_gmp_mod_big_int(Term t, Int i2)
Term
Yap_gmp_mod_int_big(Int i1, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] != BIG_INT) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
@ -782,6 +792,7 @@ Yap_gmp_rem_big_int(Term t, Int i2)
Term
Yap_gmp_rem_int_big(Int i1, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] != BIG_INT) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
@ -815,6 +826,7 @@ Yap_gmp_gcd_big_big(Term t1, Term t2)
Term
Yap_gmp_gcd_int_big(Int i, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] != BIG_INT) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
@ -855,6 +867,7 @@ Yap_gmp_to_float(Term t)
Term
Yap_gmp_add_float_big(Float d, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
@ -868,6 +881,7 @@ Yap_gmp_add_float_big(Float d, Term t)
Term
Yap_gmp_sub_float_big(Float d, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
@ -881,6 +895,7 @@ Yap_gmp_sub_float_big(Float d, Term t)
Term
Yap_gmp_sub_big_float(Term t, Float d)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
@ -894,6 +909,7 @@ Yap_gmp_sub_big_float(Term t, Float d)
Term
Yap_gmp_mul_float_big(Float d, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
@ -907,6 +923,7 @@ Yap_gmp_mul_float_big(Float d, Term t)
Term
Yap_gmp_fdiv_float_big(Float d, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
@ -920,6 +937,7 @@ Yap_gmp_fdiv_float_big(Float d, Term t)
Term
Yap_gmp_fdiv_big_float(Term t, Float d)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
@ -943,6 +961,7 @@ Yap_gmp_exp_int_int(Int i1, Int i2)
Term
Yap_gmp_exp_big_int(Term t, Int i)
{
CACHE_REGS
MP_INT new;
CELL *pt = RepAppl(t);
@ -969,6 +988,7 @@ Yap_gmp_exp_big_int(Term t, Int i)
Term
Yap_gmp_exp_int_big(Int i, Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t, "^/2");
@ -982,6 +1002,7 @@ Yap_gmp_exp_int_big(Int i, Term t)
Term
Yap_gmp_exp_big_big(Term t1, Term t2)
{
CACHE_REGS
CELL *pt1 = RepAppl(t1);
CELL *pt2 = RepAppl(t2);
Float dbl1, dbl2;
@ -1116,6 +1137,7 @@ Yap_gmq_rdiv_big_big(Term t1, Term t2)
Term
Yap_gmp_fdiv_int_big(Int i1, Term t2)
{
CACHE_REGS
MP_RAT new;
MP_RAT *b1, *b2;
MP_RAT bb1, bb2;
@ -1142,6 +1164,7 @@ Yap_gmp_fdiv_int_big(Int i1, Term t2)
Term
Yap_gmp_fdiv_big_int(Term t2, Int i1)
{
CACHE_REGS
MP_RAT new;
MP_RAT *b1, *b2;
MP_RAT bb1, bb2;
@ -1168,6 +1191,7 @@ Yap_gmp_fdiv_big_int(Term t2, Int i1)
Term
Yap_gmp_fdiv_big_big(Term t1, Term t2)
{
CACHE_REGS
CELL *pt1 = RepAppl(t1);
CELL *pt2 = RepAppl(t2);
MP_RAT new;
@ -1602,6 +1626,7 @@ Yap_gmp_float_integer_part(Term t)
Term
Yap_gmp_sign(Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
return MkIntegerTerm(mpz_sgn(Yap_BigIntOfTerm(t)));
@ -1613,6 +1638,7 @@ Yap_gmp_sign(Term t)
Term
Yap_gmp_lsb(Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(t);
@ -1629,6 +1655,7 @@ Yap_gmp_lsb(Term t)
Term
Yap_gmp_msb(Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(t);
@ -1645,6 +1672,7 @@ Yap_gmp_msb(Term t)
Term
Yap_gmp_popcount(Term t)
{
CACHE_REGS
CELL *pt = RepAppl(t);
if (pt[1] == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(t);

259
C/gprof.c
View File

@ -168,12 +168,11 @@ RBfree(rb_red_blk_node *ptr)
static rb_red_blk_node *
RBTreeCreate(void) {
CACHE_REGS
rb_red_blk_node* temp;
/* see the comment in the rb_red_blk_tree structure in red_black_tree.h */
/* for information on nil and root */
temp=LOCAL_ProfilerNil= RBMalloc(sizeof(rb_red_blk_node));
temp=GLOBAL_ProfilerNil= RBMalloc(sizeof(rb_red_blk_node));
temp->parent=temp->left=temp->right=temp;
temp->pcs=0;
temp->red=0;
@ -181,7 +180,7 @@ RBTreeCreate(void) {
temp->pe=NULL;
temp->source=GPROF_NO_EVENT;;
temp = RBMalloc(sizeof(rb_red_blk_node));
temp->parent=temp->left=temp->right=LOCAL_ProfilerNil;
temp->parent=temp->left=temp->right=GLOBAL_ProfilerNil;
temp->key=temp->lim=NULL;
temp->pe=NULL;
temp->source=GPROF_NO_EVENT;
@ -211,9 +210,8 @@ RBTreeCreate(void) {
static void
LeftRotate(rb_red_blk_node* x) {
CACHE_REGS
rb_red_blk_node* y;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=GLOBAL_ProfilerNil;
/* I originally wrote this function to use the sentinel for */
/* nil to avoid checking for nil. However this introduces a */
@ -244,7 +242,7 @@ LeftRotate(rb_red_blk_node* x) {
x->parent=y;
#ifdef DEBUG_ASSERT
Assert(!LOCAL_ProfilerNil->red,"nil not red in LeftRotate");
Assert(!GLOBAL_ProfilerNil->red,"nil not red in LeftRotate");
#endif
}
@ -268,9 +266,8 @@ LeftRotate(rb_red_blk_node* x) {
static void
RightRotate(rb_red_blk_node* y) {
CACHE_REGS
rb_red_blk_node* x;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=GLOBAL_ProfilerNil;
/* I originally wrote this function to use the sentinel for */
/* nil to avoid checking for nil. However this introduces a */
@ -300,7 +297,7 @@ RightRotate(rb_red_blk_node* y) {
y->parent=x;
#ifdef DEBUG_ASSERT
Assert(!LOCAL_ProfilerNil->red,"nil not red in RightRotate");
Assert(!GLOBAL_ProfilerNil->red,"nil not red in RightRotate");
#endif
}
@ -321,15 +318,14 @@ RightRotate(rb_red_blk_node* y) {
static void
TreeInsertHelp(rb_red_blk_node* z) {
CACHE_REGS
/* This function should only be called by InsertRBTree (see above) */
rb_red_blk_node* x;
rb_red_blk_node* y;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=GLOBAL_ProfilerNil;
z->left=z->right=rb_nil;
y=LOCAL_ProfilerRoot;
x=LOCAL_ProfilerRoot->left;
y=GLOBAL_ProfilerRoot;
x=GLOBAL_ProfilerRoot->left;
while( x != rb_nil) {
y=x;
if (x->key > z->key) { /* x.key > z.key */
@ -339,7 +335,7 @@ TreeInsertHelp(rb_red_blk_node* z) {
}
}
z->parent=y;
if ( (y == LOCAL_ProfilerRoot) ||
if ( (y == GLOBAL_ProfilerRoot) ||
(y->key > z->key)) { /* y.key > z.key */
y->left=z;
} else {
@ -347,7 +343,7 @@ TreeInsertHelp(rb_red_blk_node* z) {
}
#ifdef DEBUG_ASSERT
Assert(!LOCAL_ProfilerNil->red,"nil not red in TreeInsertHelp");
Assert(!GLOBAL_ProfilerNil->red,"nil not red in TreeInsertHelp");
#endif
}
@ -373,7 +369,6 @@ TreeInsertHelp(rb_red_blk_node* z) {
static rb_red_blk_node *
RBTreeInsert(yamop *key, yamop *lim) {
CACHE_REGS
rb_red_blk_node * y;
rb_red_blk_node * x;
rb_red_blk_node * newNode;
@ -420,12 +415,12 @@ RBTreeInsert(yamop *key, yamop *lim) {
}
}
}
LOCAL_ProfilerRoot->left->red=0;
GLOBAL_ProfilerRoot->left->red=0;
return newNode;
#ifdef DEBUG_ASSERT
Assert(!LOCAL_ProfilerNil->red,"nil not red in RBTreeInsert");
Assert(!LOCAL_ProfilerRoot->red,"root not red in RBTreeInsert");
Assert(!GLOBAL_ProfilerNil->red,"nil not red in RBTreeInsert");
Assert(!GLOBAL_ProfilerRoot->red,"root not red in RBTreeInsert");
#endif
}
@ -445,12 +440,11 @@ RBTreeInsert(yamop *key, yamop *lim) {
static rb_red_blk_node*
RBExactQuery(yamop* q) {
CACHE_REGS
rb_red_blk_node* x;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* rb_nil=GLOBAL_ProfilerNil;
if (!LOCAL_ProfilerRoot) return NULL;
x=LOCAL_ProfilerRoot->left;
if (!GLOBAL_ProfilerRoot) return NULL;
x=GLOBAL_ProfilerRoot->left;
if (x == rb_nil) return NULL;
while(x->key != q) {/*assignemnt*/
if (x->key > q) { /* x->key > q */
@ -466,13 +460,12 @@ RBExactQuery(yamop* q) {
static rb_red_blk_node*
RBLookup(yamop *entry) {
CACHE_REGS
rb_red_blk_node *current;
if (!LOCAL_ProfilerRoot)
if (!GLOBAL_ProfilerRoot)
return NULL;
current = LOCAL_ProfilerRoot->left;
while (current != LOCAL_ProfilerNil) {
current = GLOBAL_ProfilerRoot->left;
while (current != GLOBAL_ProfilerNil) {
if (current->key <= entry && current->lim >= entry) {
return current;
}
@ -502,8 +495,7 @@ RBLookup(yamop *entry) {
/***********************************************************************/
static void RBDeleteFixUp(rb_red_blk_node* x) {
CACHE_REGS
rb_red_blk_node* root=LOCAL_ProfilerRoot->left;
rb_red_blk_node* root=GLOBAL_ProfilerRoot->left;
rb_red_blk_node *w;
while( (!x->red) && (root != x)) {
@ -582,10 +574,9 @@ static void RBDeleteFixUp(rb_red_blk_node* x) {
static rb_red_blk_node*
TreeSuccessor(rb_red_blk_node* x) {
CACHE_REGS
rb_red_blk_node* y;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* root=LOCAL_ProfilerRoot;
rb_red_blk_node* rb_nil=GLOBAL_ProfilerNil;
rb_red_blk_node* root=GLOBAL_ProfilerRoot;
if (rb_nil != (y = x->right)) { /* assignment to y is intentional */
while(y->left != rb_nil) { /* returns the minium of the right subtree of x */
@ -621,11 +612,10 @@ TreeSuccessor(rb_red_blk_node* x) {
static void
RBDelete(rb_red_blk_node* z){
CACHE_REGS
rb_red_blk_node* y;
rb_red_blk_node* x;
rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
rb_red_blk_node* root=LOCAL_ProfilerRoot;
rb_red_blk_node* rb_nil=GLOBAL_ProfilerNil;
rb_red_blk_node* root=GLOBAL_ProfilerRoot;
y= ((z->left == rb_nil) || (z->right == rb_nil)) ? z : TreeSuccessor(z);
x= (y->left == rb_nil) ? y->right : y->left;
@ -674,40 +664,38 @@ RBDelete(rb_red_blk_node* z){
char *set_profile_dir(char *);
char *set_profile_dir(char *name){
CACHE_REGS
int size=0;
if (name!=NULL) {
size=strlen(name)+1;
if (LOCAL_DIRNAME!=NULL) free(LOCAL_DIRNAME);
LOCAL_DIRNAME=malloc(size);
if (LOCAL_DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
strcpy(LOCAL_DIRNAME,name);
if (GLOBAL_DIRNAME!=NULL) free(GLOBAL_DIRNAME);
GLOBAL_DIRNAME=malloc(size);
if (GLOBAL_DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
strcpy(GLOBAL_DIRNAME,name);
}
if (LOCAL_DIRNAME==NULL) {
if (GLOBAL_DIRNAME==NULL) {
do {
if (LOCAL_DIRNAME!=NULL) free(LOCAL_DIRNAME);
if (GLOBAL_DIRNAME!=NULL) free(GLOBAL_DIRNAME);
size+=20;
LOCAL_DIRNAME=malloc(size);
if (LOCAL_DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
} while (getcwd(LOCAL_DIRNAME, size-15)==NULL);
GLOBAL_DIRNAME=malloc(size);
if (GLOBAL_DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
} while (getcwd(GLOBAL_DIRNAME, size-15)==NULL);
}
return LOCAL_DIRNAME;
return GLOBAL_DIRNAME;
}
char *profile_names(int);
char *profile_names(int k) {
CACHE_REGS
static char *FNAME=NULL;
int size=200;
if (LOCAL_DIRNAME==NULL) set_profile_dir(NULL);
size=strlen(LOCAL_DIRNAME)+40;
if (GLOBAL_DIRNAME==NULL) set_profile_dir(NULL);
size=strlen(GLOBAL_DIRNAME)+40;
if (FNAME!=NULL) free(FNAME);
FNAME=malloc(size);
if (FNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
strcpy(FNAME,LOCAL_DIRNAME);
strcpy(FNAME,GLOBAL_DIRNAME);
if (k==PROFILING_FILE) {
sprintf(FNAME,"%s/PROFILING_%d",FNAME,getpid());
@ -721,8 +709,7 @@ char *profile_names(int k) {
void del_profile_files(void);
void del_profile_files() {
CACHE_REGS
if (LOCAL_DIRNAME!=NULL) {
if (GLOBAL_DIRNAME!=NULL) {
remove(profile_names(PROFPREDS_FILE));
remove(profile_names(PROFILING_FILE));
}
@ -730,18 +717,17 @@ void del_profile_files() {
void
Yap_inform_profiler_of_clause__(void *code_start, void *code_end, PredEntry *pe,gprof_info index_code) {
CACHE_REGS
buf_ptr b;
buf_extra e;
LOCAL_ProfOn = TRUE;
GLOBAL_ProfOn = TRUE;
b.tag = '+';
b.ptr= code_start;
e.inf= index_code;
e.end= code_end;
e.pe= pe;
fwrite(&b,sizeof(b),1,LOCAL_FPreds);
fwrite(&e,sizeof(e),1,LOCAL_FPreds);
LOCAL_ProfOn = FALSE;
fwrite(&b,sizeof(b),1,GLOBAL_FPreds);
fwrite(&e,sizeof(e),1,GLOBAL_FPreds);
GLOBAL_ProfOn = FALSE;
}
typedef struct clause_entry {
@ -756,8 +742,7 @@ static Int profend( USES_REGS1 );
static void
clean_tree(rb_red_blk_node* node) {
CACHE_REGS
if (node == LOCAL_ProfilerNil)
if (node == GLOBAL_ProfilerNil)
return;
clean_tree(node->left);
clean_tree(node->right);
@ -766,20 +751,18 @@ clean_tree(rb_red_blk_node* node) {
static void
reset_tree(void) {
CACHE_REGS
clean_tree(LOCAL_ProfilerRoot);
Yap_FreeCodeSpace((char *)LOCAL_ProfilerNil);
LOCAL_ProfilerNil = LOCAL_ProfilerRoot = NULL;
LOCAL_ProfCalls = LOCAL_ProfGCs = LOCAL_ProfHGrows = LOCAL_ProfSGrows = LOCAL_ProfMallocs = LOCAL_ProfOns = 0L;
clean_tree(GLOBAL_ProfilerRoot);
Yap_FreeCodeSpace((char *)GLOBAL_ProfilerNil);
GLOBAL_ProfilerNil = GLOBAL_ProfilerRoot = NULL;
GLOBAL_ProfCalls = GLOBAL_ProfGCs = GLOBAL_ProfHGrows = GLOBAL_ProfSGrows = GLOBAL_ProfMallocs = GLOBAL_ProfOns = 0L;
}
static int
InitProfTree(void)
{
CACHE_REGS
if (LOCAL_ProfilerRoot)
if (GLOBAL_ProfilerRoot)
reset_tree();
while (!(LOCAL_ProfilerRoot = RBTreeCreate())) {
while (!(GLOBAL_ProfilerRoot = RBTreeCreate())) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "while initialisating profiler");
return FALSE;
@ -790,15 +773,14 @@ InitProfTree(void)
static void RemoveCode(CODEADDR clau)
{
CACHE_REGS
rb_red_blk_node* x, *node;
PredEntry *pp;
UInt count;
if (!LOCAL_ProfilerRoot) return;
if (!GLOBAL_ProfilerRoot) return;
if (!(x = RBExactQuery((yamop *)clau))) {
/* send message */
LOCAL_ProfOn = FALSE;
GLOBAL_ProfOn = FALSE;
return;
}
pp = x->pe;
@ -811,7 +793,7 @@ static void RemoveCode(CODEADDR clau)
node->pe = pp;
node->pcs = count;
/* send message */
LOCAL_ProfOn = FALSE;
GLOBAL_ProfOn = FALSE;
return;
} else {
node->pcs += count;
@ -827,21 +809,21 @@ showprofres( USES_REGS1 ) {
/* First part: Read information about predicates and store it on yap trail */
InitProfTree();
LOCAL_ProfGCs=0;
LOCAL_ProfMallocs=0;
LOCAL_ProfHGrows=0;
LOCAL_ProfSGrows=0;
LOCAL_ProfIndexing=0;
LOCAL_FProf=fopen(profile_names(PROFILING_FILE),"r");
if (LOCAL_FProf==NULL) { fclose(LOCAL_FProf); return FALSE; }
while (fread(&buf, sizeof(buf), 1, LOCAL_FProf)) {
GLOBAL_ProfGCs=0;
GLOBAL_ProfMallocs=0;
GLOBAL_ProfHGrows=0;
GLOBAL_ProfSGrows=0;
GLOBAL_ProfIndexing=0;
GLOBAL_FProf=fopen(profile_names(PROFILING_FILE),"r");
if (GLOBAL_FProf==NULL) { fclose(GLOBAL_FProf); return FALSE; }
while (fread(&buf, sizeof(buf), 1, GLOBAL_FProf)) {
switch (buf.tag) {
case '+':
{
rb_red_blk_node *node;
buf_extra e;
if (fread(&e,sizeof(buf_extra),1,LOCAL_FProf) == 0)
if (fread(&e,sizeof(buf_extra),1,GLOBAL_FProf) == 0)
return FALSE;;
node = RBTreeInsert(buf.ptr, e.end);
node->pe = e.pe;
@ -855,13 +837,13 @@ showprofres( USES_REGS1 ) {
md = (prolog_exec_mode)buf.ptr;
if (md & GCMode) {
LOCAL_ProfGCs++;
GLOBAL_ProfGCs++;
} else if (md & MallocMode) {
LOCAL_ProfMallocs++;
GLOBAL_ProfMallocs++;
} else if (md & GrowHeapMode) {
LOCAL_ProfHGrows++;
GLOBAL_ProfHGrows++;
} else if (md & GrowStackMode) {
LOCAL_ProfSGrows++;
GLOBAL_ProfSGrows++;
}
}
break;
@ -888,7 +870,7 @@ showprofres( USES_REGS1 ) {
case GPROF_NEW_LU_SWITCH:
case GPROF_NEW_STATIC_SWITCH:
case GPROF_NEW_EXPAND_BLOCK:
LOCAL_ProfIndexing++;
GLOBAL_ProfIndexing++;
break;
default:
break;
@ -898,8 +880,8 @@ showprofres( USES_REGS1 ) {
}
}
}
fclose(LOCAL_FProf);
if (LOCAL_ProfCalls==0)
fclose(GLOBAL_FProf);
if (GLOBAL_ProfCalls==0)
return TRUE;
return TRUE;
}
@ -916,20 +898,20 @@ prof_alrm(int signo, siginfo_t *si, void *scv)
yamop *current_p;
buf_ptr b;
LOCAL_ProfCalls++;
GLOBAL_ProfCalls++;
/* skip an interrupt */
if (LOCAL_ProfOn) {
LOCAL_ProfOns++;
if (GLOBAL_ProfOn) {
GLOBAL_ProfOns++;
return;
}
LOCAL_ProfOn = TRUE;
GLOBAL_ProfOn = TRUE;
oldpc = (void *) CONTEXT_PC(scv);
if (LOCAL_PrologMode & TestMode) {
b.tag = '?';
b.ptr= (void *)LOCAL_PrologMode;
fwrite(&b,sizeof(b),1,LOCAL_FPreds);
LOCAL_ProfOn = FALSE;
fwrite(&b,sizeof(b),1,GLOBAL_FPreds);
GLOBAL_ProfOn = FALSE;
return;
}
@ -961,34 +943,33 @@ prof_alrm(int signo, siginfo_t *si, void *scv)
#if DEBUG
fprintf(stderr,"Oops: %p, %p\n", oldpc, current_p);
#endif
LOCAL_ProfOn = FALSE;
GLOBAL_ProfOn = FALSE;
return;
}
#endif
b.tag = '.';
b.ptr= current_p;
fwrite(&b,sizeof(b),1,LOCAL_FPreds);
LOCAL_ProfOn = FALSE;
fwrite(&b,sizeof(b),1,GLOBAL_FPreds);
GLOBAL_ProfOn = FALSE;
}
void
Yap_InformOfRemoval(void *clau)
{
CACHE_REGS
LOCAL_ProfOn = TRUE;
if (LOCAL_FPreds != NULL) {
GLOBAL_ProfOn = TRUE;
if (GLOBAL_FPreds != NULL) {
/* just store info about what is going on */
buf_ptr b;
b.tag = '-';
b.ptr= clau;
fwrite(&b,sizeof(b),1,LOCAL_FPreds);
LOCAL_ProfOn = FALSE;
fwrite(&b,sizeof(b),1,GLOBAL_FPreds);
GLOBAL_ProfOn = FALSE;
return;
}
LOCAL_ProfOn = FALSE;
GLOBAL_ProfOn = FALSE;
}
static Int profend( USES_REGS1 );
@ -998,25 +979,25 @@ profnode( USES_REGS1 ) {
Term t1 = Deref(ARG1), tleft, tright;
rb_red_blk_node *node;
if (!LOCAL_ProfilerRoot)
if (!GLOBAL_ProfilerRoot)
return FALSE;
if (!(node = (rb_red_blk_node *)IntegerOfTerm(t1)))
node = LOCAL_ProfilerRoot;
node = GLOBAL_ProfilerRoot;
/*
if (node->key)
fprintf(stderr,"%p: %p,%p,%d,%p(%d),%p,%p\n",node,node->key,node->lim,node->pcs,node->pe,node->pe->ArityOfPE,node->right,node->left);
*/
if (node->left == LOCAL_ProfilerNil) {
if (node->left == GLOBAL_ProfilerNil) {
tleft = TermNil;
} else {
tleft = MkIntegerTerm((Int)node->left);
}
if (node->left == LOCAL_ProfilerNil) {
if (node->left == GLOBAL_ProfilerNil) {
tleft = TermNil;
} else {
tleft = MkIntegerTerm((Int)node->left);
}
if (node->right == LOCAL_ProfilerNil) {
if (node->right == GLOBAL_ProfilerNil) {
tright = TermNil;
} else {
tright = MkIntegerTerm((Int)node->right);
@ -1032,23 +1013,23 @@ profnode( USES_REGS1 ) {
static Int
profglobs( USES_REGS1 ) {
return
Yap_unify(ARG1,MkIntegerTerm(LOCAL_ProfCalls)) &&
Yap_unify(ARG2,MkIntegerTerm(LOCAL_ProfGCs)) &&
Yap_unify(ARG3,MkIntegerTerm(LOCAL_ProfHGrows)) &&
Yap_unify(ARG4,MkIntegerTerm(LOCAL_ProfSGrows)) &&
Yap_unify(ARG5,MkIntegerTerm(LOCAL_ProfMallocs)) &&
Yap_unify(ARG6,MkIntegerTerm(LOCAL_ProfIndexing)) &&
Yap_unify(ARG7,MkIntegerTerm(LOCAL_ProfOns)) ;
Yap_unify(ARG1,MkIntegerTerm(GLOBAL_ProfCalls)) &&
Yap_unify(ARG2,MkIntegerTerm(GLOBAL_ProfGCs)) &&
Yap_unify(ARG3,MkIntegerTerm(GLOBAL_ProfHGrows)) &&
Yap_unify(ARG4,MkIntegerTerm(GLOBAL_ProfSGrows)) &&
Yap_unify(ARG5,MkIntegerTerm(GLOBAL_ProfMallocs)) &&
Yap_unify(ARG6,MkIntegerTerm(GLOBAL_ProfIndexing)) &&
Yap_unify(ARG7,MkIntegerTerm(GLOBAL_ProfOns)) ;
}
static Int
do_profinit( USES_REGS1 )
{
// LOCAL_FPreds=fopen(profile_names(PROFPREDS_FILE),"w+");
// if (LOCAL_FPreds == NULL) return FALSE;
LOCAL_FProf=fopen(profile_names(PROFILING_FILE),"w+");
if (LOCAL_FProf==NULL) { fclose(LOCAL_FProf); return FALSE; }
LOCAL_FPreds = LOCAL_FProf;
// GLOBAL_FPreds=fopen(profile_names(PROFPREDS_FILE),"w+");
// if (GLOBAL_FPreds == NULL) return FALSE;
GLOBAL_FProf=fopen(profile_names(PROFILING_FILE),"w+");
if (GLOBAL_FProf==NULL) { fclose(GLOBAL_FProf); return FALSE; }
GLOBAL_FPreds = GLOBAL_FProf;
Yap_dump_code_area_for_profiler();
return TRUE;
@ -1056,22 +1037,21 @@ do_profinit( USES_REGS1 )
static Int profinit( USES_REGS1 )
{
if (LOCAL_ProfilerOn!=0) return (FALSE);
if (GLOBAL_ProfilerOn!=0) return (FALSE);
if (!do_profinit( PASS_REGS1 ))
return FALSE;
LOCAL_ProfilerOn = -1; /* Inited but not yet started */
GLOBAL_ProfilerOn = -1; /* Inited but not yet started */
return(TRUE);
}
static Int start_profilers(int msec)
{
CACHE_REGS
struct itimerval t;
struct sigaction sa;
if (LOCAL_ProfilerOn!=-1) {
if (GLOBAL_ProfilerOn!=-1) {
return FALSE; /* have to go through profinit */
}
sa.sa_sigaction=prof_alrm;
@ -1086,15 +1066,21 @@ static Int start_profilers(int msec)
t.it_value.tv_usec=msec;
setitimer(ITIMER_PROF,&t,NULL);
LOCAL_ProfilerOn = msec;
GLOBAL_ProfilerOn = msec;
return TRUE;
}
static Int profoff( USES_REGS1 ) {
if (LOCAL_ProfilerOn>0) {
setitimer(ITIMER_PROF,NULL,NULL);
LOCAL_ProfilerOn = -1;
if (GLOBAL_ProfilerOn>0) {
struct itimerval t;
t.it_interval.tv_sec=0;
t.it_interval.tv_usec=0;
t.it_value.tv_sec=0;
t.it_value.tv_usec=0;
setitimer(ITIMER_PROF,&t,NULL);
GLOBAL_ProfilerOn = -1;
return TRUE;
}
return FALSE;
@ -1113,22 +1099,22 @@ static Int ProfOn0( USES_REGS1 ) {
}
static Int profison( USES_REGS1 ) {
return (LOCAL_ProfilerOn > 0);
return (GLOBAL_ProfilerOn > 0);
}
static Int profalt( USES_REGS1 ) {
if (LOCAL_ProfilerOn==0) return(FALSE);
if (LOCAL_ProfilerOn==-1) return ProfOn( PASS_REGS1 );
if (GLOBAL_ProfilerOn==0) return(FALSE);
if (GLOBAL_ProfilerOn==-1) return ProfOn( PASS_REGS1 );
return profoff( PASS_REGS1 );
}
static Int profend( USES_REGS1 )
{
if (LOCAL_ProfilerOn==0) return(FALSE);
if (GLOBAL_ProfilerOn==0) return(FALSE);
profoff( PASS_REGS1 ); /* Make sure profiler is off */
LOCAL_ProfilerOn=0;
fclose(LOCAL_FProf);
LOCAL_FPreds = NULL;
GLOBAL_ProfilerOn=0;
fclose(GLOBAL_FProf);
GLOBAL_FPreds = NULL;
return TRUE;
}
@ -1178,9 +1164,8 @@ void
Yap_InitLowProf(void)
{
#if LOW_PROF
CACHE_REGS
LOCAL_ProfCalls = 0;
LOCAL_ProfilerOn = FALSE;
GLOBAL_ProfCalls = 0;
GLOBAL_ProfilerOn = FALSE;
Yap_InitCPred("profinit",0, profinit, SafePredFlag);
Yap_InitCPred("profend" ,0, profend, SafePredFlag);

5
C/index.c
View File

@ -1923,10 +1923,7 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi
} else {
Yap_IndexSpace_EXT += sz;
}
{
CACHE_REGS
Yap_inform_profiler_of_clause(ncode, (CODEADDR)ncode+sz, ap, GPROF_NEW_EXPAND_BLOCK);
}
Yap_inform_profiler_of_clause(ncode, (CODEADDR)ncode+sz, ap, GPROF_NEW_EXPAND_BLOCK);
/* create an expand_block */
ncode->opc = Yap_opcode(_expand_clauses);
ncode->u.sssllp.p = ap;

6
C/init.c
View File

@ -882,6 +882,8 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
static void
InitStdPreds(void)
{
void initIO(void);
Yap_InitCPreds();
Yap_InitBackCPreds();
BACKUP_MACHINE_REGS();
@ -1288,17 +1290,21 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
if (Heap < MinHeapSpace)
Heap = MinHeapSpace;
Heap = AdjustPageSize(Heap * K);
Heap /= (K);
/* sanity checking for data areas */
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
Trail = AdjustPageSize(Trail * K);
Trail /= (K);
if (Stack < MinStackSpace)
Stack = MinStackSpace;
Stack = AdjustPageSize(Stack * K);
Stack /= (K);
if (!Atts)
Atts = 2048*sizeof(CELL);
else
Atts = AdjustPageSize(Atts * K);
Atts /= (K);
#if defined(YAPOR) || defined(THREADS)
worker_id = 0;
#endif /* YAPOR || THREADS */

22
C/inlines.c
View File

@ -760,6 +760,13 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */
ENDD(d0);
}
static Term
cp_as_integer(choiceptr cp USES_REGS)
{
return(MkIntegerTerm(LCL0-(CELL *)cp));
}
static Int
p_cut_by( USES_REGS1 )
{
@ -897,6 +904,20 @@ cont_genarg( USES_REGS1 )
Yap_unify(ARG3,pt[0]);
}
static Int
p_save_cp( USES_REGS1 )
{
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (!IsVarTerm(t)) return(FALSE);
td = cp_as_integer(B PASS_REGS);
Bind((CELL *)t,td);
return(TRUE);
}
void
Yap_InitInlines(void)
@ -904,6 +925,7 @@ Yap_InitInlines(void)
CACHE_REGS
Term cm = CurrentModule;
Yap_InitAsmPred("$$cut_by", 1, _cut_by, p_cut_by, SafePredFlag);
Yap_InitAsmPred("$$save_by", 1, _save_by, p_save_cp, SafePredFlag);
Yap_InitAsmPred("atom", 1, _atom, p_atom, SafePredFlag);
Yap_InitAsmPred("atomic", 1, _atomic, p_atomic, SafePredFlag);
Yap_InitAsmPred("integer", 1, _integer, p_integer, SafePredFlag);

2
C/scanner.c
View File

@ -230,6 +230,7 @@ extern double atof(const char *);
static Term
float_send(char *s, int sign)
{
CACHE_REGS
Float f = (Float)atof(s);
#if HAVE_FINITE
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
@ -512,6 +513,7 @@ num_send_error_message(char s[])
static Term
get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, int sign)
{
CACHE_REGS
char *sp = s;
int ch = *chp;
Int val = 0L, base = ch - '0';

378
C/signals.c Normal file
View File

@ -0,0 +1,378 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: signal.c *
* comments: Signal Handling & Debugger Support *
* *
* *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
#define HAS_CACHE_REGS 1
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "eval.h"
#include "yapio.h"
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
#include <stdio.h>
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_MALLOC_H
#include <malloc.h>
#endif
#include <wchar.h>
inline static void
do_signal(yap_signals sig USES_REGS)
{
LOCK(LOCAL_SignalLock);
if (!LOCAL_InterruptsDisabled)
CreepFlag = Unsigned(LCL0);
LOCAL_ActiveSignals |= sig;
UNLOCK(LOCAL_SignalLock);
}
inline static void
undo_signal(yap_signals sig USES_REGS)
{
LOCK(LOCAL_SignalLock);
if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) == sig) {
CreepFlag = CalculateStackGap();
}
LOCAL_ActiveSignals &= ~sig;
UNLOCK(LOCAL_SignalLock);
}
static Int
p_creep( USES_REGS1 )
{
Atom at;
PredEntry *pred;
at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
do_signal(YAP_CREEP_SIGNAL PASS_REGS);
return TRUE;
}
static Int
p_stop_creeping( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals) {
CreepFlag = CalculateStackGap();
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
static Int
p_meta_creep( USES_REGS1 )
{
Atom at;
PredEntry *pred;
at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals |= YAP_DELAY_CREEP_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
static Int
p_creep_allowed( USES_REGS1 )
{
if (PP != NULL) {
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
} else {
UNLOCK(LOCAL_SignalLock);
}
return TRUE;
}
return FALSE;
}
static Int
p_debug_on( USES_REGS1 )
{
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
if (LOCAL_DebugOn)
return Yap_unify(MkAtomTerm(AtomTrue),ARG1);
else
return Yap_unify(MkAtomTerm(AtomFalse),ARG1);
}
if (t == MkAtomTerm(AtomTrue))
LOCAL_DebugOn = TRUE;
else
LOCAL_DebugOn = FALSE;
return TRUE;
}
void
Yap_signal(yap_signals sig)
{
CACHE_REGS
do_signal(sig PASS_REGS);
}
void
Yap_undo_signal(yap_signals sig)
{
CACHE_REGS
undo_signal(sig PASS_REGS);
}
#ifdef DEBUG
static Int
p_debug( USES_REGS1 )
{ /* $debug(+Flag) */
int i = IntOfTerm(Deref(ARG1));
if (i >= 'a' && i <= 'z')
GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96];
return (1);
}
#endif
static Int
p_first_signal( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
#ifdef THREADS
pthread_mutex_lock(&(LOCAL_ThreadHandle.tlock));
#endif
/* always do wakeups first, because you don't want to keep the
non-backtrackable variable bad */
if (LOCAL_ActiveSignals & YAP_WAKEUP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_WAKEUP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigWakeUp));
}
if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_ITI_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigIti));
}
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_INT_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigInt));
}
if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_USR2_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr2));
}
if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_USR1_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr1));
}
if (LOCAL_ActiveSignals & YAP_PIPE_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_PIPE_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigPipe));
}
if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_HUP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigHup));
}
if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_ALARM_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigAlarm));
}
if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_VTALARM_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigVTAlarm));
}
if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigDelayCreep));
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigCreep));
}
if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_TRACE_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigTrace));
}
if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_DEBUG_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigDebug));
}
if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_BREAK_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigBreak));
}
if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_STACK_DUMP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigStackDump));
}
if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_STATISTICS_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigStatistics));
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomFail));
}
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return FALSE;
}
static Int
p_continue_signals( USES_REGS1 )
{
/* hack to force the signal anew */
if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) {
Yap_signal(YAP_ITI_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_signal(YAP_INT_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) {
Yap_signal(YAP_USR2_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) {
Yap_signal(YAP_USR1_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) {
Yap_signal(YAP_HUP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) {
Yap_signal(YAP_ALARM_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) {
Yap_signal(YAP_VTALARM_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
Yap_signal(YAP_CREEP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
Yap_signal(YAP_DELAY_CREEP_SIGNAL|YAP_CREEP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) {
Yap_signal(YAP_TRACE_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) {
Yap_signal(YAP_DEBUG_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) {
Yap_signal(YAP_BREAK_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) {
Yap_signal(YAP_STACK_DUMP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) {
Yap_signal(YAP_STATISTICS_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
Yap_signal(YAP_FAIL_SIGNAL);
}
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
return TRUE;
}
void
Yap_InitSignalCPreds(void)
{
/* Basic predicates for the debugger */
Yap_InitCPred("$creep", 0, p_creep, SafePredFlag);
Yap_InitCPred("$meta_creep", 0, p_meta_creep, SafePredFlag);
Yap_InitCPred("$stop_creeping", 0, p_stop_creeping, SafePredFlag);
Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$debug_on", 1, p_debug_on, 0);
Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0);
#ifdef DEBUG
Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag);
#endif
}

263
C/stdpreds.c
View File

@ -292,7 +292,7 @@ STD_PROTO(static Int p_values, ( USES_REGS1 ));
STD_PROTO(static CODEADDR *FindAtom, (CODEADDR, int *));
#endif /* undefined */
STD_PROTO(static Int p_opdec, ( USES_REGS1 ));
STD_PROTO(static Term get_num, (char *));
STD_PROTO(static Term get_num, (char * USES_REGS));
STD_PROTO(static Int p_name, ( USES_REGS1 ));
STD_PROTO(static Int p_atom_chars, ( USES_REGS1 ));
STD_PROTO(static Int p_atom_codes, ( USES_REGS1 ));
@ -474,207 +474,6 @@ p_values( USES_REGS1 )
return (TRUE);
}
inline static void
do_signal(yap_signals sig USES_REGS)
{
LOCK(LOCAL_SignalLock);
if (!LOCAL_InterruptsDisabled)
CreepFlag = Unsigned(LCL0);
LOCAL_ActiveSignals |= sig;
UNLOCK(LOCAL_SignalLock);
}
inline static void
undo_signal(yap_signals sig USES_REGS)
{
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == sig) {
CreepFlag = CalculateStackGap();
}
LOCAL_ActiveSignals &= ~sig;
UNLOCK(LOCAL_SignalLock);
}
static Int
p_creep( USES_REGS1 )
{
Atom at;
PredEntry *pred;
at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
do_signal(YAP_CREEP_SIGNAL PASS_REGS);
return TRUE;
}
static Int
p_signal_creep( USES_REGS1 )
{
Atom at;
PredEntry *pred;
at = AtomCreep;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals |= YAP_CREEP_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
static Int
p_disable_creep( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
UNLOCK(LOCAL_SignalLock);
return FALSE;
}
/* never fails */
static Int
p_disable_docreep( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
} else {
UNLOCK(LOCAL_SignalLock);
}
return TRUE;
}
static Int
p_stop_creep( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals) {
CreepFlag = CalculateStackGap();
}
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
void
Yap_signal(yap_signals sig)
{
CACHE_REGS
do_signal(sig PASS_REGS);
}
void
Yap_undo_signal(yap_signals sig)
{
CACHE_REGS
undo_signal(sig PASS_REGS);
}
#ifdef undefined
/*
* Returns where some particular piece of code is, it may take its time but
* then you only need it while creeping, so why bother ?
*/
static CODEADDR *
FindAtom(codeToFind, arity)
CODEADDR codeToFind;
unsigned int *arityp;
{
Atom a;
int i;
for (i = 0; i < AtomHashTableSize; ++i) {
READ_LOCK(HashChain[i].AeRWLock);
a = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AeRWLock);
while (a != NIL) {
register PredEntry *pp;
AtomEntry *ae = RepAtom(a);
READ_LOCK(ae->ARWLock);
pp = RepPredProp(RepAtom(a)->PropsOfAE);
while (!EndOfPAEntr(pp) && ((pp->KindOfPE & 0x8000)
|| (pp->CodeOfPred != codeToFind)))
pp = RepPredProp(pp->NextOfPE);
if (pp != NIL) {
CODEADDR *out;
PELOCK(90,pp);
out = &(pp->CodeOfPred)
*arityp = pp->ArityOfPE;
UNLOCK(pp->PELock);
READ_UNLOCK(ae->ARWLock);
return (out);
}
a = RepAtom(a)->NextOfAE;
READ_UNLOCK(ae->ARWLock);
}
}
for (i = 0; i < WideAtomHashTableSize; ++i) {
READ_LOCK(HashChain[i].AeRWLock);
a = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AeRWLock);
while (a != NIL) {
register PredEntry *pp;
AtomEntry *ae = RepAtom(a);
READ_LOCK(ae->ARWLock);
pp = RepPredProp(RepAtom(a)->PropsOfAE);
while (!EndOfPAEntr(pp) && ((pp->KindOfPE & 0x8000)
|| (pp->CodeOfPred != codeToFind)))
pp = RepPredProp(pp->NextOfPE);
if (pp != NIL) {
CODEADDR *out;
PELOCK(91,pp);
out = &(pp->CodeOfPred)
*arityp = pp->ArityOfPE;
UNLOCK(pp->PELock);
READ_UNLOCK(ae->ARWLock);
return (out);
}
a = RepAtom(a)->NextOfAE;
READ_UNLOCK(ae->ARWLock);
}
}
*arityp = 0;
return (0);
}
/*
* This is called when you want to creep a C-predicate or a predicate written
* in assembly
*/
CELL
FindWhatCreep(toCreep)
CELL toCreep;
{
unsigned int arity;
Atom at;
CODEADDR *place;
if (toCreep > 64) { /* written in C */
int i;
place = FindAtom((CODEADDR) toCreep, &arity);
*--ASP = Unsigned(P);
*--ASP = N = arity;
for (i = 1; i <= arity; ++i)
*--ASP = X[i];
/* P = CellPtr(CCREEPCODE); */
return (Unsigned(place));
}
}
#endif /* undefined */
static Int
p_opdec( USES_REGS1 )
{ /* '$opdec'(p,type,atom) */
@ -738,7 +537,7 @@ strtod(s, pe)
#endif
static Term
get_num(char *t)
get_num(char *t USES_REGS)
{
Term out;
IOSTREAM *smem = Sopenmem(&t, NULL, "r");
@ -1033,7 +832,7 @@ p_name( USES_REGS1 )
return(FALSE);
}
if (IsAtomTerm(t) && AtomOfTerm(t) == AtomNil) {
if ((NewT = get_num(String)) == TermNil) {
if ((NewT = get_num(String PASS_REGS)) == TermNil) {
Atom at;
while ((at = Yap_LookupAtom(String)) == NIL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
@ -1576,7 +1375,7 @@ p_atom_concat( USES_REGS1 )
if (wide_mode) {
wchar_t *cptr = (wchar_t *)(((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE), *cpt0;
wchar_t *top = (wchar_t *)AuxSp;
unsigned char *atom_str;
unsigned char *atom_str = NULL;
Atom ahead;
UInt sz;
@ -2428,7 +2227,7 @@ p_number_chars( USES_REGS1 )
}
}
*s++ = '\0';
if ((NewT = get_num(String)) == TermNil) {
if ((NewT = get_num(String PASS_REGS)) == TermNil) {
Yap_Error(SYNTAX_ERROR, gen_syntax_error(Yap_LookupAtom(String), "number_chars"), "while scanning %s", String);
return (FALSE);
}
@ -2495,7 +2294,7 @@ p_number_atom( USES_REGS1 )
return(FALSE);
}
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if ((NewT = get_num(s)) == TermNil) {
if ((NewT = get_num(s PASS_REGS)) == TermNil) {
Yap_Error(SYNTAX_ERROR, gen_syntax_error(Yap_LookupAtom(String), "number_atom"), "while scanning %s", s);
return (FALSE);
}
@ -2588,7 +2387,7 @@ p_number_codes( USES_REGS1 )
}
}
*s++ = '\0';
if ((NewT = get_num(String)) == TermNil) {
if ((NewT = get_num(String PASS_REGS)) == TermNil) {
Yap_Error(SYNTAX_ERROR, gen_syntax_error(Yap_LookupAtom(String), "number_codes"), "while scanning %s", String);
return (FALSE);
}
@ -2653,7 +2452,7 @@ p_atom_number( USES_REGS1 )
return FALSE;
}
s = RepAtom(at)->StrOfAE; /* alloc temp space on Trail */
if ((NewT = get_num(s)) == TermNil) {
if ((NewT = get_num(s PASS_REGS)) == TermNil) {
Yap_Error(SYNTAX_ERROR, gen_syntax_error(at, "atom_number"), "while scanning %s", s);
return FALSE;
}
@ -3466,18 +3265,6 @@ init_current_atom_op( USES_REGS1 )
return cont_current_atom_op( PASS_REGS1 );
}
#ifdef DEBUG
static Int
p_debug( USES_REGS1 )
{ /* $debug(+Flag) */
int i = IntOfTerm(Deref(ARG1));
if (i >= 'a' && i <= 'z')
GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96];
return (1);
}
#endif
static Int
p_flags( USES_REGS1 )
{ /* $flags(+Functor,+Mod,?OldFlags,?NewFlags) */
@ -4010,7 +3797,7 @@ p_executable( USES_REGS1 )
if (GLOBAL_argv && GLOBAL_argv[0])
Yap_TrueFileName (GLOBAL_argv[0], LOCAL_FileNameBuf, FALSE);
else
strncpy(LOCAL_FileNameBuf,Yap_FindExecutable (), YAP_FILENAME_MAX) ;
strncpy(LOCAL_FileNameBuf, Yap_FindExecutable(), YAP_FILENAME_MAX-1) ;
return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)),ARG1);
}
@ -4034,23 +3821,25 @@ p_access_yap_flags( USES_REGS1 )
if (flag < 0 || flag >= NUMBER_OF_YAP_FLAGS) {
return(FALSE);
}
#ifdef TABLING
if (flag == TABLING_MODE_FLAG) {
#ifdef TABLING
tout = TermNil;
if (IsMode_LocalTrie(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLocalTrie), tout);
else if (IsMode_GlobalTrie(yap_flags[flag]))
else // if (IsMode_GlobalTrie(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomGlobalTrie), tout);
if (IsMode_ExecAnswers(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomExecAnswers), tout);
else if (IsMode_LoadAnswers(yap_flags[flag]))
if (IsMode_LoadAnswers(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLoadAnswers), tout);
if (IsMode_Batched(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomBatched), tout);
else if (IsMode_Local(yap_flags[flag]))
else // if (IsMode_ExecAnswers(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomExecAnswers), tout);
if (IsMode_Local(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomLocal), tout);
} else
else // if (IsMode_Batched(yap_flags[flag]))
tout = MkPairTerm(MkAtomTerm(AtomBatched), tout);
#else
tout = MkAtomTerm(AtomFalse);
#endif /* TABLING */
} else
tout = MkIntegerTerm(yap_flags[flag]);
return(Yap_unify(ARG2, tout));
}
@ -4439,17 +4228,6 @@ Yap_InitCPreds(void)
Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag);
Yap_InitCPred("$enter_undefp", 0, p_enterundefp, SafePredFlag);
Yap_InitCPred("$exit_undefp", 0, p_exitundefp, SafePredFlag);
/* basic predicates for the prolog machine tracer */
/* they are defined in analyst.c */
/* Basic predicates for the debugger */
Yap_InitCPred("$creep", 0, p_creep, SafePredFlag);
Yap_InitCPred("$signal_creep", 0, p_signal_creep, SafePredFlag);
Yap_InitCPred("$disable_creep", 0, p_disable_creep, SafePredFlag);
Yap_InitCPred("$disable_docreep", 0, p_disable_docreep, SafePredFlag);
Yap_InitCPred("$do_not_creep", 0, p_stop_creep, SafePredFlag|SyncPredFlag);
#ifdef DEBUG
Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag);
#endif
/* Accessing and changing the flags for a predicate */
Yap_InitCPred("$flags", 4, p_flags, SyncPredFlag);
/* hiding and unhiding some predicates */
@ -4508,6 +4286,7 @@ Yap_InitCPreds(void)
#endif
Yap_udi_init();
Yap_InitSignalCPreds();
Yap_InitUserCPreds();
Yap_InitUtilCPreds();
Yap_InitSortPreds();

205
C/sysbits.c
View File

@ -1822,7 +1822,7 @@ ReceiveSignal (int s)
#ifdef SIGHUP
case SIGHUP:
/* force the system to creep */
Yap_signal (YAP_HUP_SIGNAL);
/* Just ignore SUGHUP Yap_signal (YAP_HUP_SIGNAL); */
break;
#endif /* defined(SIGHUP) */
default:
@ -2804,207 +2804,6 @@ Yap_ReInitWallTime (void)
InitLastWtime();
}
static Int
p_first_signal( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
#ifdef THREADS
pthread_mutex_lock(&(LOCAL_ThreadHandle.tlock));
#endif
/* always do wakeups first, because you don't want to keep the
non-backtrackable variable bad */
if (LOCAL_ActiveSignals & YAP_WAKEUP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_WAKEUP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigWakeUp));
}
if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_ITI_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigIti));
}
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_INT_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigInt));
}
if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_USR2_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr2));
}
if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_USR1_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr1));
}
if (LOCAL_ActiveSignals & YAP_PIPE_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_PIPE_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigPipe));
}
if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_HUP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigHup));
}
if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_ALARM_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigAlarm));
}
if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_VTALARM_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigVTAlarm));
}
if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigDelayCreep));
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigCreep));
}
if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_TRACE_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigTrace));
}
if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_DEBUG_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigDebug));
}
if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_BREAK_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigBreak));
}
if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_STACK_DUMP_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigStackDump));
}
if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_STATISTICS_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigStatistics));
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomFail));
}
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
UNLOCK(LOCAL_SignalLock);
return FALSE;
}
static Int
p_continue_signals( USES_REGS1 )
{
/* hack to force the signal anew */
if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) {
Yap_signal(YAP_ITI_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_signal(YAP_INT_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) {
Yap_signal(YAP_USR2_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) {
Yap_signal(YAP_USR1_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) {
Yap_signal(YAP_HUP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) {
Yap_signal(YAP_ALARM_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) {
Yap_signal(YAP_VTALARM_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
Yap_signal(YAP_CREEP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
Yap_signal(YAP_DELAY_CREEP_SIGNAL|YAP_CREEP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) {
Yap_signal(YAP_TRACE_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) {
Yap_signal(YAP_DEBUG_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) {
Yap_signal(YAP_BREAK_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) {
Yap_signal(YAP_STACK_DUMP_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) {
Yap_signal(YAP_STATISTICS_SIGNAL);
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
Yap_signal(YAP_FAIL_SIGNAL);
}
#ifdef THREADS
pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock));
#endif
return TRUE;
}
static Int
p_unix( USES_REGS1 )
{
@ -3295,9 +3094,7 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$set_fpu_exceptions", 0, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);
Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag);

4
C/utilpreds.c
View File

@ -4921,7 +4921,7 @@ numbervar_singleton(USES_REGS1)
}
static void
renumbervar(Term t, Int id)
renumbervar(Term t, Int id USES_REGS)
{
Term *ts = RepAppl(t);
ts[1] = MkIntegerTerm(id);
@ -4975,7 +4975,7 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
continue;
}
if (singles && ap2 >= InitialH && ap2 < H) {
renumbervar(d0, numbv++);
renumbervar(d0, numbv++ PASS_REGS);
continue;
}
/* store the terms to visit */

1
H/Foreign.h
View File

@ -105,7 +105,6 @@ typedef void (*YapInitProc)(void);
#define STD_PROTO(F,A) F A
#endif
char *STD_PROTO(Yap_FindExecutable,(void));
void *STD_PROTO(Yap_LoadForeignFile,(char *, int));
int STD_PROTO(Yap_CallForeignFile,(void *, char *));
int STD_PROTO(Yap_CloseForeignFile,(void *));

34
H/TermExt.h
View File

@ -60,13 +60,14 @@ blob_type;
#include "inline-only.h"
INLINE_ONLY inline EXTERN int IsAttVar (CELL *pt);
#define IsAttVar(pt) __IsAttVar((pt) PASS_REGS)
INLINE_ONLY inline EXTERN int __IsAttVar (CELL *pt USES_REGS);
INLINE_ONLY inline EXTERN int
IsAttVar (CELL *pt)
__IsAttVar (CELL *pt USES_REGS)
{
#ifdef YAP_H
CACHE_REGS
return (pt)[-1] == (CELL)attvar_e
&& pt < H;
#else
@ -182,13 +183,13 @@ INLINE_ONLY inline EXTERN Float CpFloatUnaligned(CELL *ptr);
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT
#define MkFloatTerm(fl) __MkFloatTerm((fl) PASS_REGS)
INLINE_ONLY inline EXTERN Term MkFloatTerm (Float);
INLINE_ONLY inline EXTERN Term __MkFloatTerm (Float USES_REGS);
INLINE_ONLY inline EXTERN Term
MkFloatTerm (Float dbl)
__MkFloatTerm (Float dbl USES_REGS)
{
CACHE_REGS
return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) =
dbl, H[2] = EndSpecials, H +=
3, AbsAppl (H - 3)));
@ -303,12 +304,13 @@ IsFloatTerm (Term t)
/* extern Functor FunctorLongInt; */
INLINE_ONLY inline EXTERN Term MkLongIntTerm (Int);
#define MkLongIntTerm(i) __MkLongIntTerm((i) PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkLongIntTerm (Int USES_REGS);
INLINE_ONLY inline EXTERN Term
MkLongIntTerm (Int i)
__MkLongIntTerm (Int i USES_REGS)
{
CACHE_REGS
H[0] = (CELL) FunctorLongInt;
H[1] = (CELL) (i);
H[2] = EndSpecials;
@ -546,11 +548,12 @@ IsAttachFunc (Functor f)
#define IsAttachedTerm(t) __IsAttachedTerm(t PASS_REGS)
INLINE_ONLY inline EXTERN Int IsAttachedTerm (Term);
INLINE_ONLY inline EXTERN Int __IsAttachedTerm (Term USES_REGS);
INLINE_ONLY inline EXTERN Int
IsAttachedTerm (Term t)
__IsAttachedTerm (Term t USES_REGS)
{
return (Int) ((IsVarTerm (t) && IsAttVar(VarOfTerm(t))));
}
@ -563,17 +566,16 @@ GlobalIsAttachedTerm (Term t)
return (Int) ((IsVarTerm (t) && GlobalIsAttVar(VarOfTerm(t))));
}
INLINE_ONLY inline EXTERN Int SafeIsAttachedTerm (Term);
#define SafeIsAttachedTerm(t) __SafeIsAttachedTerm((t) PASS_REGS)
INLINE_ONLY inline EXTERN Int __SafeIsAttachedTerm (Term USES_REGS);
INLINE_ONLY inline EXTERN Int
SafeIsAttachedTerm (Term t)
__SafeIsAttachedTerm (Term t USES_REGS)
{
return (Int) (IsVarTerm (t) && IsAttVar(VarOfTerm(t)));
}
INLINE_ONLY inline EXTERN exts ExtFromCell (CELL *);
INLINE_ONLY inline EXTERN exts

10
H/Yap.h
View File

@ -107,6 +107,10 @@
#endif /* HAVE_SYS_TIME_H */
#endif /* _MSC_VER */
#if HAVE_TIME_H
#include <time.h>
#endif
#ifdef __MINGW32__
#ifndef _WIN32
#define _WIN32 1
@ -755,6 +759,10 @@ typedef struct thandle {
#endif
pthread_mutex_t tlock;
pthread_mutex_t tlock_status;
#if HAVE_GETHRTIME
hrtime_t start_of_w_times;
hrtime_t last_w_time;
#endif
#if HAVE_GETRUSAGE
struct timeval *start_of_timesp;
struct timeval *last_timep;
@ -861,6 +869,8 @@ extern struct worker_local Yap_local;
static inline void
Yap_StartSlots( USES_REGS1 ) {
if (CurSlot == LCL0-ASP)
return;
*--ASP = MkIntegerTerm(CurSlot);
*--ASP = MkIntTerm(0);
CurSlot = LCL0-ASP;

7
H/YapTags.h
View File

@ -364,10 +364,13 @@ MkPairTerm__ (Term head, Term tail USES_REGS)
#define IsAccessFunc(func) ((func) == FunctorAccess)
#ifdef YAP_H
INLINE_ONLY inline EXTERN Term MkIntegerTerm (Int);
#define MkIntegerTerm(i) __MkIntegerTerm(i PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkIntegerTerm (Int USES_REGS);
INLINE_ONLY inline EXTERN Term
MkIntegerTerm (Int n)
__MkIntegerTerm (Int n USES_REGS)
{
return (Term) (IntInBnd (n) ? MkIntTerm (n) : MkLongIntTerm (n));
}

13
H/Yapproto.h
View File

@ -182,15 +182,19 @@ Int STD_PROTO(Yap_execute_goal,(Term, int, Term));
Int STD_PROTO(Yap_exec_absmi,(int));
void STD_PROTO(Yap_trust_last,(void));
Term STD_PROTO(Yap_GetException,(void));
void STD_PROTO(Yap_PrepGoal,(UInt, CELL *, choiceptr USES_REGS));
/* exo.c */
void STD_PROTO(Yap_InitExoPreds,(void));
/* foreign.c */
char *STD_PROTO(Yap_FindExecutable,(void));
/* gprof.c */
void STD_PROTO(Yap_InitLowProf,(void));
#if LOW_PROF
void STD_PROTO(Yap_inform_profiler_of_clause__,(void *,void *,struct pred_entry *, gprof_info));
#define Yap_inform_profiler_of_clause(CODE0,CODEF,AP,MODE) {if (LOCAL_FPreds) Yap_inform_profiler_of_clause__(CODE0,CODEF,AP,MODE);}
#define Yap_inform_profiler_of_clause(CODE0,CODEF,AP,MODE) {if (GLOBAL_FPreds) Yap_inform_profiler_of_clause__(CODE0,CODEF,AP,MODE);}
#else
#define Yap_inform_profiler_of_clause(CODE0,CODEF,AP,MODE)
#endif
@ -334,6 +338,11 @@ void STD_PROTO(Yap_InitSavePreds,(void));
/* scanner.c */
/* signals.c */
void STD_PROTO(Yap_signal,(yap_signals));
void STD_PROTO(Yap_undo_signal,(yap_signals));
void STD_PROTO(Yap_InitSignalCPreds,(void));
/* sort.c */
void STD_PROTO(Yap_InitSortPreds,(void));
@ -341,8 +350,6 @@ void STD_PROTO(Yap_InitSortPreds,(void));
void STD_PROTO(Yap_InitBackCPreds,(void));
void STD_PROTO(Yap_InitCPreds,(void));
void STD_PROTO(Yap_show_statistics,(void));
void STD_PROTO(Yap_signal,(yap_signals));
void STD_PROTO(Yap_undo_signal,(yap_signals));
int STD_PROTO(Yap_IsOpMaxPrio,(Atom));
/* sysbits.c */

1
H/amidefs.h
View File

@ -163,6 +163,7 @@ typedef enum {
_number,
_var,
_cut_by,
_save_by,
_db_ref,
_primitive,
_dif,

34
H/arith2.h
View File

@ -26,7 +26,7 @@ add_overflow(Int x, Int i, Int j)
}
inline static Term
add_int(Int i, Int j)
add_int(Int i, Int j USES_REGS)
{
Int x = i+j;
#if USE_GMP
@ -51,7 +51,7 @@ sub_overflow(Int x, Int i, Int j)
}
inline static Term
sub_int(Int i, Int j)
sub_int(Int i, Int j USES_REGS)
{
Int x = i-j;
#if USE_GMP
@ -105,7 +105,7 @@ mul_overflow(Int z, Int i1, Int i2)
#endif
inline static Term
times_int(Int i1, Int i2) {
times_int(Int i1, Int i2 USES_REGS) {
#ifdef USE_GMP
Int z;
DO_MULTI();
@ -151,7 +151,7 @@ clrsb(Int i)
#endif
inline static Term
do_sll(Int i, Int j) /* j > 0 */
do_sll(Int i, Int j USES_REGS) /* j > 0 */
{
#ifdef USE_GMP
if (
@ -174,13 +174,13 @@ do_sll(Int i, Int j) /* j > 0 */
static inline Term
p_plus(Term t1, Term t2) {
p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2));
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
@ -230,13 +230,13 @@ p_plus(Term t1, Term t2) {
}
static Term
p_minus(Term t1, Term t2) {
p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2));
return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
@ -290,13 +290,13 @@ p_minus(Term t1, Term t2) {
static Term
p_times(Term t1, Term t2) {
p_times(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return(times_int(IntegerOfTerm(t1),IntegerOfTerm(t2)));
return(times_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS));
case double_e:
{
/* integer, double */
@ -348,7 +348,7 @@ p_times(Term t1, Term t2) {
}
static Term
p_div(Term t1, Term t2) {
p_div(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
@ -405,7 +405,7 @@ p_div(Term t1, Term t2) {
}
static Term
p_and(Term t1, Term t2) {
p_and(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
@ -446,7 +446,7 @@ p_and(Term t1, Term t2) {
}
static Term
p_or(Term t1, Term t2) {
p_or(Term t1, Term t2 USES_REGS) {
switch(ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
@ -487,7 +487,7 @@ p_or(Term t1, Term t2) {
}
static Term
p_sll(Term t1, Term t2) {
p_sll(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
@ -501,7 +501,7 @@ p_sll(Term t1, Term t2) {
}
RINT(SLR(IntegerOfTerm(t1), -i2));
}
return do_sll(IntegerOfTerm(t1),i2);
return do_sll(IntegerOfTerm(t1),i2 PASS_REGS);
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
@ -535,7 +535,7 @@ p_sll(Term t1, Term t2) {
}
static Term
p_slr(Term t1, Term t2) {
p_slr(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
@ -547,7 +547,7 @@ p_slr(Term t1, Term t2) {
if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
}
return do_sll(IntegerOfTerm(t1), -i2);
return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS);
}
RINT(SLR(IntegerOfTerm(t1), i2));
}

38
H/clause.h
View File

@ -170,25 +170,43 @@ typedef struct index_t {
UInt ntrys;
UInt nentries;
UInt hsize;
CELL **key;
BITS32 *key;
CELL *cls;
CELL *links;
BITS32 *links;
size_t size;
yamop *code;
} Index_t;
INLINE_ONLY EXTERN inline UInt EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);
INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);
INLINE_ONLY EXTERN inline UInt
INLINE_ONLY EXTERN inline BITS32
EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL* ptr)
{
return ptr-it->links;
return 1+(ptr-it->cls);
}
INLINE_ONLY EXTERN inline CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt off);
INLINE_ONLY EXTERN inline CELL *
EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt off)
EXO_OFFSET_TO_ADDRESS(struct index_t *it, BITS32 off)
{
if (off == 0L)
return NULL;
return (it->cls-1)+off;
}
INLINE_ONLY EXTERN inline BITS32 ADDRESS_TO_LINK(struct index_t *it, CELL *ptr);
INLINE_ONLY EXTERN inline BITS32
ADDRESS_TO_LINK(struct index_t *it, CELL* ptr)
{
return ptr-it->links;
}
INLINE_ONLY EXTERN inline CELL *LINK_TO_ADDRESS(struct index_t *it, BITS32 off);
INLINE_ONLY EXTERN inline CELL *
LINK_TO_ADDRESS(struct index_t *it, BITS32 off)
{
return it->links+off;
}
@ -323,8 +341,10 @@ same_lu_block(yamop **paddr, yamop *p)
}
#endif
#define Yap_MkStaticRefTerm(cp) __Yap_MkStaticRefTerm((cp) PASS_REGS)
static inline Term
Yap_MkStaticRefTerm(StaticClause *cp)
__Yap_MkStaticRefTerm(StaticClause *cp USES_REGS)
{
Term t[1];
t[0] = MkIntegerTerm((Int)cp);
@ -337,8 +357,10 @@ Yap_ClauseFromTerm(Term t)
return (StaticClause *)IntegerOfTerm(ArgOfTerm(1,t));
}
#define Yap_MkMegaRefTerm(ap, ipc) __Yap_MkMegaRefTerm((ap), (ipc) PASS_REGS)
static inline Term
Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc)
__Yap_MkMegaRefTerm(PredEntry *ap,yamop *ipc USES_REGS)
{
Term t[2];
t[0] = MkIntegerTerm((Int)ap);

17
H/dglobals.h
View File

@ -100,3 +100,20 @@
#define GLOBAL_RestoreFile Yap_global->RestoreFile_
#define GLOBAL_ProfCalls Yap_global->ProfCalls_
#define GLOBAL_ProfGCs Yap_global->ProfGCs_
#define GLOBAL_ProfHGrows Yap_global->ProfHGrows_
#define GLOBAL_ProfSGrows Yap_global->ProfSGrows_
#define GLOBAL_ProfMallocs Yap_global->ProfMallocs_
#define GLOBAL_ProfIndexing Yap_global->ProfIndexing_
#define GLOBAL_ProfOn Yap_global->ProfOn_
#define GLOBAL_ProfOns Yap_global->ProfOns_
#define GLOBAL_ProfilerRoot Yap_global->ProfilerRoot_
#define GLOBAL_ProfilerNil Yap_global->ProfilerNil_
#define GLOBAL_DIRNAME Yap_global->DIRNAME_
#if LOW_PROF
#define GLOBAL_ProfilerOn Yap_global->ProfilerOn_
#define GLOBAL_FProf Yap_global->FProf_
#define GLOBAL_FPreds Yap_global->FPreds_
#endif /* LOW_PROF */

33
H/dlocals.h
View File

@ -310,6 +310,8 @@
#define LOCAL_matherror LOCAL->matherror_
#define REMOTE_matherror(wid) REMOTE(wid)->matherror_
#define LOCAL_CurrentError LOCAL->CurrentError_
#define REMOTE_CurrentError(wid) REMOTE(wid)->CurrentError_
#define LOCAL_heap_overflows LOCAL->heap_overflows_
#define REMOTE_heap_overflows(wid) REMOTE(wid)->heap_overflows_
@ -396,37 +398,6 @@
#define REMOTE_ImportDBRefHashTableNum(wid) REMOTE(wid)->ImportDBRefHashTableNum_
#define LOCAL_ImportFAILCODE LOCAL->ImportFAILCODE_
#define REMOTE_ImportFAILCODE(wid) REMOTE(wid)->ImportFAILCODE_
#define LOCAL_ProfCalls LOCAL->ProfCalls_
#define REMOTE_ProfCalls(wid) REMOTE(wid)->ProfCalls_
#define LOCAL_ProfGCs LOCAL->ProfGCs_
#define REMOTE_ProfGCs(wid) REMOTE(wid)->ProfGCs_
#define LOCAL_ProfHGrows LOCAL->ProfHGrows_
#define REMOTE_ProfHGrows(wid) REMOTE(wid)->ProfHGrows_
#define LOCAL_ProfSGrows LOCAL->ProfSGrows_
#define REMOTE_ProfSGrows(wid) REMOTE(wid)->ProfSGrows_
#define LOCAL_ProfMallocs LOCAL->ProfMallocs_
#define REMOTE_ProfMallocs(wid) REMOTE(wid)->ProfMallocs_
#define LOCAL_ProfIndexing LOCAL->ProfIndexing_
#define REMOTE_ProfIndexing(wid) REMOTE(wid)->ProfIndexing_
#define LOCAL_ProfOn LOCAL->ProfOn_
#define REMOTE_ProfOn(wid) REMOTE(wid)->ProfOn_
#define LOCAL_ProfOns LOCAL->ProfOns_
#define REMOTE_ProfOns(wid) REMOTE(wid)->ProfOns_
#define LOCAL_ProfilerRoot LOCAL->ProfilerRoot_
#define REMOTE_ProfilerRoot(wid) REMOTE(wid)->ProfilerRoot_
#define LOCAL_ProfilerNil LOCAL->ProfilerNil_
#define REMOTE_ProfilerNil(wid) REMOTE(wid)->ProfilerNil_
#define LOCAL_DIRNAME LOCAL->DIRNAME_
#define REMOTE_DIRNAME(wid) REMOTE(wid)->DIRNAME_
#if LOW_PROF
#define LOCAL_ProfilerOn LOCAL->ProfilerOn_
#define REMOTE_ProfilerOn(wid) REMOTE(wid)->ProfilerOn_
#define LOCAL_FProf LOCAL->FProf_
#define REMOTE_FProf(wid) REMOTE(wid)->FProf_
#define LOCAL_FPreds LOCAL->FPreds_
#define REMOTE_FPreds(wid) REMOTE(wid)->FPreds_
#endif /* LOW_PROF */
#define LOCAL_FunctorVar LOCAL->FunctorVar_
#define REMOTE_FunctorVar(wid) REMOTE(wid)->FunctorVar_

8
H/eval.h
View File

@ -314,12 +314,16 @@ size_t STD_PROTO(Yap_gmp_to_size,(Term, int));
int STD_PROTO(Yap_term_to_existing_big,(Term, MP_INT *));
int STD_PROTO(Yap_term_to_existing_rat,(Term, MP_RAT *));
void Yap_gmp_set_bit(Int i, Term t);
#endif
INLINE_ONLY inline EXTERN Term Yap_Mk64IntegerTerm(YAP_LONG_LONG);
#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i) PASS_REGS)
INLINE_ONLY inline EXTERN Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
INLINE_ONLY inline EXTERN Term
Yap_Mk64IntegerTerm(YAP_LONG_LONG i)
__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
{
if (i <= Int_MAX && i >= Int_MIN) {
return MkIntegerTerm((Int)i);

17
H/hglobals.h
View File

@ -99,4 +99,21 @@ typedef struct global_data {
char* RestoreFile_;
Int ProfCalls_;
Int ProfGCs_;
Int ProfHGrows_;
Int ProfSGrows_;
Int ProfMallocs_;
Int ProfIndexing_;
Int ProfOn_;
Int ProfOns_;
struct RB_red_blk_node* ProfilerRoot_;
struct RB_red_blk_node* ProfilerNil_;
char* DIRNAME_;
#if LOW_PROF
int ProfilerOn_;
FILE* FProf_;
FILE* FPreds_;
#endif /* LOW_PROF */
} w_shared;

18
H/hlocals.h
View File

@ -176,6 +176,7 @@ typedef struct worker_local {
struct db_globs* s_dbg_;
yap_error_number matherror_;
yap_error_number CurrentError_;
int heap_overflows_;
Int total_heap_overflow_time_;
@ -223,23 +224,6 @@ typedef struct worker_local {
UInt ImportDBRefHashTableSize_;
UInt ImportDBRefHashTableNum_;
yamop *ImportFAILCODE_;
Int ProfCalls_;
Int ProfGCs_;
Int ProfHGrows_;
Int ProfSGrows_;
Int ProfMallocs_;
Int ProfIndexing_;
Int ProfOn_;
Int ProfOns_;
struct RB_red_blk_node* ProfilerRoot_;
struct RB_red_blk_node* ProfilerNil_;
char* DIRNAME_;
#if LOW_PROF
int ProfilerOn_;
FILE* FProf_;
FILE* FPreds_;
#endif /* LOW_PROF */
Functor FunctorVar_;
UInt ibnds_[256];

17
H/iglobals.h
View File

@ -99,4 +99,21 @@ static void InitGlobal(void) {
GLOBAL_DIRNAME = NULL;
#if LOW_PROF
GLOBAL_ProfilerOn = FALSE;
GLOBAL_FProf = NULL;
GLOBAL_FPreds = NULL;
#endif /* LOW_PROF */
}

18
H/ilocals.h
View File

@ -176,6 +176,7 @@ static void InitWorker(int wid) {
REMOTE_matherror(wid) = YAP_NO_ERROR;
REMOTE_CurrentError(wid) = YAP_NO_ERROR;
REMOTE_heap_overflows(wid) = 0;
REMOTE_total_heap_overflow_time(wid) = 0;
@ -223,23 +224,6 @@ static void InitWorker(int wid) {
REMOTE_ImportDBRefHashTableSize(wid) = 0;
REMOTE_ImportDBRefHashTableNum(wid) = 0;
REMOTE_ImportFAILCODE(wid) = NULL;
REMOTE_DIRNAME(wid) = NULL;
#if LOW_PROF
REMOTE_ProfilerOn(wid) = FALSE;
REMOTE_FProf(wid) = NULL;
REMOTE_FPreds(wid) = NULL;
#endif /* LOW_PROF */
REMOTE_FunctorVar(wid) = FunctorVar;

1
H/pl-codelist.h
View File

@ -10,6 +10,7 @@ INIT_SEQ_STRING(size_t n)
static inline Word
EXTEND_SEQ_CODES(Word ptr, int c) {
CACHE_REGS
ptr[0] = MkIntegerTerm(c);
ptr[1] = AbsPair(ptr+2);

2
H/pl-incl.h
View File

@ -46,6 +46,8 @@
#define PLVERSION YAP_VERSION
#define PLNAME "yap"
#define SWIP "swi_"
/* try not to pollute the SWI space */
#ifdef P
#undef P

17
H/rglobals.h
View File

@ -99,4 +99,21 @@ static void RestoreGlobal(void) {
#if LOW_PROF
#endif /* LOW_PROF */
}

4
H/rheap.h
View File

@ -821,10 +821,6 @@ RestoreExpandList__( USES_REGS1 )
static void
RestoreUdiControlBlocks(void)
{
if (Yap_heap_regs->udi_control_blocks) {
Yap_Error(SYSTEM_ERROR, TermNil,
"YAP cannot restore UDI entries!!\n");
}
}
static void

18
H/rlocals.h
View File

@ -188,6 +188,7 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef LOAD_DYLD
#endif
@ -223,23 +224,6 @@ static void RestoreWorker(int wid USES_REGS) {
#if LOW_PROF
#endif /* LOW_PROF */

165
LGPL/pairs.pl
View File

@ -1,165 +0,0 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2006, University of Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(pairs,
[ pairs_keys_values/3,
pairs_values/2,
pairs_keys/2,
group_pairs_by_key/2,
transpose_pairs/2,
map_list_to_pairs/3
]).
/** <module> Operations on key-value lists
This module implements common operations on Key-Value lists, also known
as _Pairs_. Pairs have great practical value, especially due to
keysort/2 and the library assoc.pl.
This library is based on disussion in the SWI-Prolog mailinglist,
including specifications from Quintus and a library proposal by Richard
O'Keefe.
@see keysort/2, library(assoc)
@author Jan Wielemaker
*/
%% pairs_keys_values(?Pairs, ?Keys, ?Values) is det.
%
% True if Keys holds the keys of Pairs and Values the values.
%
% Deterministic if any argument is instantiated to a finite list
% and the others are either free or finite lists. All three lists
% are in the same order.
%
% @see pairs_values/2 and pairs_keys/2.
pairs_keys_values(Pairs, Keys, Values) :-
( nonvar(Pairs) ->
pairs_keys_values_(Pairs, Keys, Values)
; nonvar(Keys) ->
keys_values_pairs(Keys, Values, Pairs)
; values_keys_pairs(Values, Keys, Pairs)
).
pairs_keys_values_([], [], []).
pairs_keys_values_([K-V|Pairs], [K|Keys], [V|Values]) :-
pairs_keys_values_(Pairs, Keys, Values).
keys_values_pairs([], [], []).
keys_values_pairs([K|Ks], [V|Vs], [K-V|Pairs]) :-
keys_values_pairs(Ks, Vs, Pairs).
values_keys_pairs([], [], []).
values_keys_pairs([V|Vs], [K|Ks], [K-V|Pairs]) :-
values_keys_pairs(Vs, Ks, Pairs).
%% pairs_values(+Pairs, -Values) is det.
%
% Remove the keys from a list of Key-Value pairs. Same as
% pairs_keys_values(Pairs, _, Values)
pairs_values([], []).
pairs_values([_-V|T0], [V|T]) :-
pairs_values(T0, T).
%% pairs_keys(+Pairs, -Keys) is det.
%
% Remove the values from a list of Key-Value pairs. Same as
% pairs_keys_values(Pairs, Keys, _)
pairs_keys([], []).
pairs_keys([K-_|T0], [K|T]) :-
pairs_keys(T0, T).
%% group_pairs_by_key(+Pairs, -Joined:list(Key-Values)) is det.
%
% Group values with the same key. Pairs must be a key-sorted list.
% For example:
%
% ==
% ?- group_pairs_by_key([a-2, a-1, b-4], X).
%
% X = [a-[2,1], b-[4]]
% ==
%
% @param Pairs Key-Value list, sorted to the standard order
% of terms (as keysort/2 does)
% @param Joined List of Key-Group, where Group is the
% list of Values associated with Key.
group_pairs_by_key([], []).
group_pairs_by_key([M-N|T0], [M-[N|TN]|T]) :-
same_key(M, T0, TN, T1),
group_pairs_by_key(T1, T).
same_key(M, [M-N|T0], [N|TN], T) :- !,
same_key(M, T0, TN, T).
same_key(_, L, [], L).
%% transpose_pairs(+Pairs, -Transposed) is det.
%
% Swap Key-Value to Value-Key and sort the result on Value
% (the new key) using keysort/2.
transpose_pairs(Pairs, Transposed) :-
flip_pairs(Pairs, Flipped),
keysort(Flipped, Transposed).
flip_pairs([], []).
flip_pairs([Key-Val|Pairs], [Val-Key|Flipped]) :-
flip_pairs(Pairs, Flipped).
%% map_list_to_pairs(:Function, +List, -Keyed)
%
% Create a key-value list by mapping each element of List.
% For example, if we have a list of lists we can create a
% list of Length-List using
%
% ==
% map_list_to_pairs(length, ListOfLists, Pairs),
% ==
:- meta_predicate
map_list_to_pairs(2, +, -).
map_list_to_pairs(Function, List, Pairs) :-
map_list_to_pairs2(List, Function, Pairs).
map_list_to_pairs2([], _, []).
map_list_to_pairs2([H|T0], Pred, [K-H|T]) :-
call(Pred, H, K),
map_list_to_pairs2(T0, Pred, T).

20
Makefile.in
View File

@ -257,7 +257,7 @@ C_SOURCES= \
$(srcdir)/C/qlyr.c \
$(srcdir)/C/qlyw.c \
$(srcdir)/C/range.c \
$(srcdir)/C/save.c $(srcdir)/C/scanner.c \
$(srcdir)/C/save.c $(srcdir)/C/scanner.c $(srcdir)/C/signals.c \
$(srcdir)/C/sort.c $(srcdir)/C/stdpreds.c $(srcdir)/C/sysbits.c \
$(srcdir)/C/threads.c \
$(srcdir)/C/tracer.c $(srcdir)/C/unify.c $(srcdir)/C/userpreds.c \
@ -366,7 +366,7 @@ ENGINE_OBJECTS = \
myddas_util.o myddas_statistics.o myddas_top_level.o \
myddas_wkb2prolog.o modules.o other.o \
parser.o qlyr.o qlyw.o range.o \
save.o scanner.o sort.o stdpreds.o \
save.o scanner.o signals.o sort.o stdpreds.o \
sysbits.o threads.o tracer.o \
udi.o\
unify.o userpreds.o utilpreds.o \
@ -466,6 +466,9 @@ qlyw.o: $(srcdir)/C/qlyw.c config.h
save.o: $(srcdir)/C/save.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/C/save.c -o $@
signals.o: $(srcdir)/C/signals.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/C/signals.c -o $@
sysbits.o: $(srcdir)/C/sysbits.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/C/sysbits.c -o $@
@ -697,7 +700,7 @@ all: startup.yss
@INSTALL_DLLS@ (cd library/random; $(MAKE))
@INSTALL_DLLS@ (cd library/regex; $(MAKE))
@INSTALL_DLLS@ (cd library/rltree; $(MAKE))
@ENABLE_WINCONSOLE@ (cd LGPL/swi_console; $(MAKE))
@ENABLE_WINCONSOLE@ (cd swi/console; $(MAKE))
@INSTALL_DLLS@ (cd library/system; $(MAKE))
@INSTALL_DLLS@ (cd library/tries; $(MAKE))
@ENABLE_CLIB@ @INSTALL_DLLS@ (cd packages/clib; $(MAKE))
@ -737,7 +740,7 @@ yap-win: yap-win@EXEC_SUFFIX@
yapwin: yap-win@EXEC_SUFFIX@
yap-win@EXEC_SUFFIX@: $(PLCONS_OBJECTS) $(HEADERS) @YAPLIB@
(cd LGPL/swi_console; $(MAKE))
(cd swi/console; $(MAKE))
$(MPI_CC) -municode -DUNICODE -D_UNICODE $(EXECUTABLE_CFLAGS) $(LDFLAGS) -Wl,-subsystem,windows -o yap-win $(PLCONS_OBJECTS) plterm.dll @YAPLIB@ $(LIBS) @MPI_LIBS@
libYap.a: $(LIB_OBJECTS)
@ -839,7 +842,7 @@ install_win32: startup.yss @ENABLE_WINCONSOLE@ yap-win@EXEC_SUFFIX@
(cd library/regex; $(MAKE) install)
(cd library/rltree; $(MAKE) install)
(cd library/system; $(MAKE) install)
@ENABLE_WINCONSOLE@ (cd LGPL/swi_console; $(MAKE) install)
@ENABLE_WINCONSOLE@ (cd swi/console; $(MAKE) install)
@INSTALL_MATLAB@ (cd library/matlab; $(MAKE) install)
@ENABLE_REAL@ (cd packages/real; $(MAKE) install)
(cd library/tries; $(MAKE) install)
@ -880,11 +883,10 @@ install_data: install_copied_files install_bin
install_copied_files:
(cd library ; $(MAKE) install)
@ENABLE_MINISAT@ (cd packages/swi-minisat2; $(MAKE) install)
(cd LGPL ; $(MAKE) install)
(cd GPL ; $(MAKE) install)
(cd swi/library ; $(MAKE) install)
$(INSTALL_DATA) $(srcdir)/LGPL/pillow/icon_address.pl $(DESTDIR)$(SHAREDIR)/Yap/
$(INSTALL_DATA) $(srcdir)/LGPL/pillow/pillow.pl $(DESTDIR)$(SHAREDIR)/Yap/
@INSTALLCLP@(cd LGPL/clp ; $(MAKE) install)
@INSTALLCLP@(cd swi/library/clp ; $(MAKE) install)
(cd packages/CLPBN ; $(MAKE) install)
(cd packages/meld; $(MAKE) install)
(cd packages/xml; $(MAKE) install)
@ -911,7 +913,7 @@ clean: clean_docs
@INSTALL_DLLS@ (cd library/random; $(MAKE) clean)
@INSTALL_DLLS@ (cd library/regex; $(MAKE) clean)
@INSTALL_DLLS@ (cd library/rltree; $(MAKE) clean)
@ENABLE_WINCONSOLE@ (cd LGPL/swi_console; $(MAKE) clean)
@ENABLE_WINCONSOLE@ (cd swi/console; $(MAKE) clean)
@INSTALL_DLLS@ (cd library/system; $(MAKE) clean)
@INSTALL_DLLS@ (cd library/tries; $(MAKE) clean)
@ENABLE_CLIB@ @INSTALL_DLLS@ (cd packages/clib; $(MAKE) clean)

130
OPTYap/tab.macros.h
View File

@ -22,39 +22,39 @@
#include "opt.mavar.h"
#ifdef THREADS
static inline void **get_insert_thread_bucket(void **, lockvar *);
static inline void **get_thread_bucket(void **);
static inline void **__get_insert_thread_bucket(void **, lockvar * USES_REGS);
static inline void **__get_thread_bucket(void ** USES_REGS);
static inline void abolish_thread_buckets(void **);
#endif /* THREADS */
static inline sg_node_ptr get_insert_subgoal_trie(tab_ent_ptr USES_REGS);
static inline sg_node_ptr get_subgoal_trie(tab_ent_ptr);
static inline sg_node_ptr __get_subgoal_trie(tab_ent_ptr USES_REGS);
static inline sg_node_ptr get_subgoal_trie_for_abolish(tab_ent_ptr USES_REGS);
static inline sg_fr_ptr *get_insert_subgoal_frame_addr(sg_node_ptr USES_REGS);
static inline sg_fr_ptr get_subgoal_frame(sg_node_ptr);
static inline sg_fr_ptr get_subgoal_frame_for_abolish(sg_node_ptr USES_REGS);
#ifdef THREADS_FULL_SHARING
static inline void SgFr_batched_cached_answers_check_insert(sg_fr_ptr, ans_node_ptr);
static inline void __SgFr_batched_cached_answers_check_insert(sg_fr_ptr, ans_node_ptr USES_REGS);
static inline int SgFr_batched_cached_answers_check_remove(sg_fr_ptr, ans_node_ptr);
#endif /* THREADS_FULL_SHARING */
#ifdef THREADS_CONSUMER_SHARING
static inline void add_to_tdv(int, int);
static inline void check_for_deadlock(sg_fr_ptr);
static inline sg_fr_ptr deadlock_detection(sg_fr_ptr);
static inline void __add_to_tdv(int, int USES_REGS);
static inline void __check_for_deadlock(sg_fr_ptr USES_REGS);
static inline sg_fr_ptr __deadlock_detection(sg_fr_ptr USES_REGS);
#endif /* THREADS_CONSUMER_SHARING */
static inline Int freeze_current_cp(void);
static inline void wake_frozen_cp(Int);
static inline void abolish_frozen_cps_until(Int);
static inline void abolish_frozen_cps_all(void);
static inline void adjust_freeze_registers(void);
static inline void mark_as_completed(sg_fr_ptr);
static inline void unbind_variables(tr_fr_ptr, tr_fr_ptr);
static inline void rebind_variables(tr_fr_ptr, tr_fr_ptr);
static inline void restore_bindings(tr_fr_ptr, tr_fr_ptr);
static inline CELL *expand_auxiliary_stack(CELL *);
static inline void abolish_incomplete_subgoals(choiceptr);
static inline Int __freeze_current_cp( USES_REGS1 );
static inline void __wake_frozen_cp(Int USES_REGS);
static inline void __abolish_frozen_cps_until(Int USES_REGS);
static inline void __abolish_frozen_cps_all( USES_REGS1 );
static inline void __adjust_freeze_registers( USES_REGS1 );
static inline void __mark_as_completed(sg_fr_ptr USES_REGS);
static inline void __unbind_variables(tr_fr_ptr, tr_fr_ptr USES_REGS);
static inline void __rebind_variables(tr_fr_ptr, tr_fr_ptr USES_REGS);
static inline void __restore_bindings(tr_fr_ptr, tr_fr_ptr USES_REGS);
static inline CELL *__expand_auxiliary_stack(CELL * USES_REGS);
static inline void __abolish_incomplete_subgoals(choiceptr USES_REGS);
#ifdef YAPOR
static inline void pruning_over_tabling_data_structures(void);
static inline void collect_suspension_frames(or_fr_ptr);
static inline void __collect_suspension_frames(or_fr_ptr USES_REGS);
#ifdef TIMESTAMP_CHECK
static inline susp_fr_ptr suspension_frame_to_resume(or_fr_ptr, long);
#else
@ -658,8 +658,9 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
******************************/
#ifdef THREADS
static inline void **get_insert_thread_bucket(void **buckets, lockvar *buckets_lock) {
CACHE_REGS
#define get_insert_thread_bucket(b, bl) __get_insert_thread_bucket((b), (bl) PASS_REGS)
static inline void **__get_insert_thread_bucket(void **buckets, lockvar *buckets_lock USES_REGS) {
/* direct bucket */
if (worker_id < THREADS_DIRECT_BUCKETS)
@ -678,9 +679,9 @@ static inline void **get_insert_thread_bucket(void **buckets, lockvar *buckets_l
return *buckets + (worker_id - THREADS_DIRECT_BUCKETS) % THREADS_DIRECT_BUCKETS;
}
#define get_thread_bucket(b) __get_thread_bucket((b) PASS_REGS)
static inline void **get_thread_bucket(void **buckets) {
CACHE_REGS
static inline void **__get_thread_bucket(void **buckets USES_REGS) {
/* direct bucket */
if (worker_id < THREADS_DIRECT_BUCKETS)
@ -729,8 +730,9 @@ static inline sg_node_ptr get_insert_subgoal_trie(tab_ent_ptr tab_ent USES_REGS)
#endif /* THREADS_NO_SHARING */
}
#define get_subgoal_trie(te) __get_subgoal_trie((te) PASS_REGS)
static inline sg_node_ptr get_subgoal_trie(tab_ent_ptr tab_ent) {
static inline sg_node_ptr __get_subgoal_trie(tab_ent_ptr tab_ent USES_REGS) {
#ifdef THREADS_NO_SHARING
sg_node_ptr *sg_node_addr = (sg_node_ptr *) get_thread_bucket((void **) &TabEnt_subgoal_trie(tab_ent));
return *sg_node_addr;
@ -825,8 +827,8 @@ static inline sg_fr_ptr get_subgoal_frame_for_abolish(sg_node_ptr sg_node USES_R
#ifdef THREADS_FULL_SHARING
static inline void SgFr_batched_cached_answers_check_insert(sg_fr_ptr sg_fr, ans_node_ptr ans_node) {
CACHE_REGS
#define SgFr_batched_cached_answers_check_insert(s, a) __SgFr_batched_cached_answers_check_insert((s), (a) PASS_REGS)
static inline void SgFr_batched_cached_answers_check_insert(sg_fr_ptr sg_fr, ans_node_ptr ans_node USES_REGS) {
if (SgFr_batched_last_answer(sg_fr) == NULL)
SgFr_batched_last_answer(sg_fr) = SgFr_first_answer(sg_fr);
@ -854,8 +856,9 @@ static inline void SgFr_batched_cached_answers_check_insert(sg_fr_ptr sg_fr, ans
return;
}
static inline int SgFr_batched_cached_answers_check_remove(sg_fr_ptr sg_fr, ans_node_ptr ans_node) {
CACHE_REGS
#define SgFr_batched_cached_answers_check_remove(s, a) __SgFr_batched_cached_answers_check_remove((s), (a) PASS_REGS)
static inline int __SgFr_batched_cached_answers_check_remove(sg_fr_ptr sg_fr, ans_node_ptr ans_node USES_REgS) {
struct answer_ref_node *local_uncons_ans;
local_uncons_ans = SgFr_batched_cached_answers(sg_fr) ;
@ -884,10 +887,10 @@ static inline int SgFr_batched_cached_answers_check_remove(sg_fr_ptr sg_fr, ans_
#ifdef THREADS_CONSUMER_SHARING
static inline void add_to_tdv(int wid, int wid_dep) {
#ifdef OUTPUT_THREADS_TABLING
CACHE_REGS
#endif /* OUTPUT_THREADS_TABLING */
#define add_to_tdv(w, wd) __add_to_tdv((w), (wd) PASS_REGS)
static inline void __add_to_tdv(int wid, int wid_dep USES_REGS) {
// thread wid next of thread wid_dep
/* check before insert */
int c_wid = ThDepFr_next(GLOBAL_th_dep_fr(wid));
@ -927,9 +930,9 @@ static inline void add_to_tdv(int wid, int wid_dep) {
return;
}
#define check_for_deadlock(s) __check_for_deadlock((s) PASS_REGS)
static inline void check_for_deadlock(sg_fr_ptr sg_fr) {
CACHE_REGS
static inline void __check_for_deadlock(sg_fr_ptr sg_fr USES_REGS) {
sg_fr_ptr local_sg_fr = deadlock_detection(sg_fr);
if (local_sg_fr){
@ -942,9 +945,9 @@ static inline void check_for_deadlock(sg_fr_ptr sg_fr) {
return;
}
#define deadlock_detection(s) __deadlock_detection((s) PASS_REGS)
static inline sg_fr_ptr deadlock_detection(sg_fr_ptr sg_fr) {
CACHE_REGS
static inline sg_fr_ptr __deadlock_detection(sg_fr_ptr sg_fr USES_REGS) {
sg_fr_ptr remote_sg_fr = REMOTE_top_sg_fr(SgFr_gen_worker(sg_fr));
while( SgFr_sg_ent(remote_sg_fr) != SgFr_sg_ent(sg_fr)){
@ -977,9 +980,9 @@ static inline sg_fr_ptr deadlock_detection(sg_fr_ptr sg_fr) {
}
#endif /* THREADS_CONSUMER_SHARING */
#define freeze_current_cp() __freeze_current_cp( PASS_REGS1 )
static inline Int freeze_current_cp(void) {
CACHE_REGS
static inline Int __freeze_current_cp(USES_REGS1) {
choiceptr freeze_cp = B;
B_FZ = freeze_cp;
@ -991,8 +994,11 @@ static inline Int freeze_current_cp(void) {
}
static inline void wake_frozen_cp(Int frozen_offset) {
CACHE_REGS
#define wake_frozen_cp(f) __wake_frozen_cp((f) PASS_REGS)
#define restore_bindings(u, r) __restore_bindings((u), (r) PASS_REGS)
static inline void __wake_frozen_cp(Int frozen_offset USES_REGS) {
choiceptr frozen_cp = (choiceptr)(LOCAL_LocalBase - frozen_offset);
restore_bindings(TR, frozen_cp->cp_tr);
@ -1003,8 +1009,9 @@ static inline void wake_frozen_cp(Int frozen_offset) {
}
static inline void abolish_frozen_cps_until(Int frozen_offset) {
CACHE_REGS
#define abolish_frozen_cps_until(f) __abolish_frozen_cps_until((f) PASS_REGS )
static inline void __abolish_frozen_cps_until(Int frozen_offset USES_REGS) {
choiceptr frozen_cp = (choiceptr)(LOCAL_LocalBase - frozen_offset);
B_FZ = frozen_cp;
@ -1013,28 +1020,28 @@ static inline void abolish_frozen_cps_until(Int frozen_offset) {
return;
}
#define abolish_frozen_cps_all() __abolish_frozen_cps_all( PASS_REGS1 )
static inline void abolish_frozen_cps_all(void) {
CACHE_REGS
static inline void __abolish_frozen_cps_all( USES_REGS1 ) {
B_FZ = (choiceptr) LOCAL_LocalBase;
H_FZ = (CELL *) LOCAL_GlobalBase;
TR_FZ = (tr_fr_ptr) LOCAL_TrailBase;
return;
}
#define adjust_freeze_registers() __adjust_freeze_registers( PASS_REGS1 )
static inline void adjust_freeze_registers(void) {
CACHE_REGS
static inline void __adjust_freeze_registers( USES_REGS1 ) {
B_FZ = DepFr_cons_cp(LOCAL_top_dep_fr);
H_FZ = B_FZ->cp_h;
TR_FZ = B_FZ->cp_tr;
return;
}
#define mark_as_completed(sg) __mark_as_completed((sg) PASS_REGS )
static inline void mark_as_completed(sg_fr_ptr sg_fr) {
static inline void __mark_as_completed(sg_fr_ptr sg_fr USES_REGS) {
#if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
CACHE_REGS
#endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
LOCK_SG_FR(sg_fr);
@ -1079,9 +1086,9 @@ static inline void mark_as_completed(sg_fr_ptr sg_fr) {
return;
}
#define unbind_variables(u, e) __unbind_variables((u), (e) PASS_REGS)
static inline void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
CACHE_REGS
static inline void __unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr USES_REGS) {
TABLING_ERROR_CHECKING(unbind_variables, unbind_tr < end_tr);
/* unbind loop */
while (unbind_tr != end_tr) {
@ -1111,8 +1118,9 @@ static inline void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
}
static inline void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
CACHE_REGS
#define rebind_variables(u, e) __rebind_variables(u, e PASS_REGS)
static inline void __rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr USES_REGS) {
TABLING_ERROR_CHECKING(rebind_variables, rebind_tr < end_tr);
/* rebind loop */
Yap_NEW_MAHASH((ma_h_inner_struct *)H PASS_REGS);
@ -1144,9 +1152,7 @@ static inline void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
return;
}
static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
CACHE_REGS
static inline void __restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr USES_REGS) {
CELL ref;
tr_fr_ptr end_tr;
@ -1218,9 +1224,9 @@ static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
return;
}
#define expand_auxiliary_stack(s) __expand_auxiliary_stack((s) PASS_REGS)
static inline CELL *expand_auxiliary_stack(CELL *stack) {
CACHE_REGS
static inline CELL *__expand_auxiliary_stack(CELL *stack USES_REGS) {
void *old_top = LOCAL_TrailTop;
INFORMATION_MESSAGE("Expanding trail in 64 Kbytes");
if (! Yap_growtrail(K64, TRUE)) { /* TRUE means 'contiguous_only' */
@ -1234,9 +1240,10 @@ static inline CELL *expand_auxiliary_stack(CELL *stack) {
}
}
#define abolish_incomplete_subgoals(p) __abolish_incomplete_subgoals((p) PASS_REGS)
static inline void abolish_incomplete_subgoals(choiceptr prune_cp) {
CACHE_REGS
static inline void __abolish_incomplete_subgoals(choiceptr prune_cp USES_REGS) {
#ifdef YAPOR
if (EQUAL_OR_YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), prune_cp))
@ -1389,8 +1396,9 @@ static inline void pruning_over_tabling_data_structures(void) {
}
static inline void collect_suspension_frames(or_fr_ptr or_fr) {
CACHE_REGS
#define collect_suspension_frames(o) __collect_suspension_frames((o) PASS_REGS)
static inline void __collect_suspension_frames(or_fr_ptr or_fr USES_REGS) {
int depth;
or_fr_ptr *susp_ptr;

39
configure vendored
View File

@ -685,6 +685,7 @@ IN_UNIX
LIBJPL
JAR
JAVADOC
JAVACFLAGS
JAVAC
JUNIT
JAVA_HOME
@ -7778,6 +7779,9 @@ elif test -e "$srcdir"/packages/jpl/Makefile.in; then
JAVAC=$yap_cv_java/bin/javac
JAVADOC=$yap_cv_java/bin/javadoc
fi
if test "x$JAVACFLAGS" = x; then
JAVACFLAGS="-source 1.4 -target 1.4"
fi
else
ENABLE_JPL="@#"
fi
@ -8133,14 +8137,13 @@ fi
then
YAPLIB_LD="\$(CC) -shared"
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
INSTALL_ENV="LD_LIBRARY_PATH=:\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
else
YAPLIB_LD="\$(CC)"
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
INSTALL_ENV="YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
PRE_INSTALL_ENV=""
fi
PRE_INSTALL_ENV="LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$(abs_top_builddir):\$(abs_top_builddir)/lib/sys"
;;
*sunos4*)
M4="/usr/5bin/m4"
@ -9800,6 +9803,7 @@ CMDEXT=sh
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc threaded code" >&5
@ -11313,9 +11317,7 @@ mkdir -p library/regex
mkdir -p library/system
mkdir -p library/tries
mkdir -p library/rltree
mkdir -p LGPL/clp
mkdir -p LGPL/swi_console
mkdir -p GPL
mkdir -p LGPL
mkdir -p packages/
mkdir -p packages/bdd
mkdir -p packages/clib
@ -11364,11 +11366,13 @@ mkdir -p packages/sgml
mkdir -p packages/xml
mkdir -p packages/zlib
mkdir -p packages/archive
mkdir -p swi
mkdir -p swi/console
mkdir -p swi/library
mkdir -p swi/library/clp
ac_config_files="$ac_config_files Makefile"
ac_config_files="$ac_config_files GPL/Makefile"
ac_config_files="$ac_config_files library/Makefile"
ac_config_files="$ac_config_files library/lammpi/Makefile"
@ -11389,12 +11393,6 @@ ac_config_files="$ac_config_files library/system/Makefile"
ac_config_files="$ac_config_files library/tries/Makefile"
ac_config_files="$ac_config_files LGPL/Makefile"
ac_config_files="$ac_config_files LGPL/clp/Makefile"
ac_config_files="$ac_config_files LGPL/swi_console/Makefile"
ac_config_files="$ac_config_files packages/Makefile.defs"
ac_config_files="$ac_config_files packages/Dialect.defs"
@ -11413,6 +11411,12 @@ ac_config_files="$ac_config_files packages/xml/Makefile"
ac_config_files="$ac_config_files packages/ProbLog/Makefile"
ac_config_files="$ac_config_files swi/console/Makefile"
ac_config_files="$ac_config_files swi/library/Makefile"
ac_config_files="$ac_config_files swi/library/clp/Makefile"
if test "$ENABLE_CHR" = ""; then
ac_config_files="$ac_config_files packages/chr/Makefile"
@ -12230,7 +12234,6 @@ do
"config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
"YapTermConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS YapTermConfig.h" ;;
"Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
"GPL/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/Makefile" ;;
"library/Makefile") CONFIG_FILES="$CONFIG_FILES library/Makefile" ;;
"library/lammpi/Makefile") CONFIG_FILES="$CONFIG_FILES library/lammpi/Makefile" ;;
"library/matlab/Makefile") CONFIG_FILES="$CONFIG_FILES library/matlab/Makefile" ;;
@ -12241,9 +12244,6 @@ do
"library/rltree/Makefile") CONFIG_FILES="$CONFIG_FILES library/rltree/Makefile" ;;
"library/system/Makefile") CONFIG_FILES="$CONFIG_FILES library/system/Makefile" ;;
"library/tries/Makefile") CONFIG_FILES="$CONFIG_FILES library/tries/Makefile" ;;
"LGPL/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/Makefile" ;;
"LGPL/clp/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/clp/Makefile" ;;
"LGPL/swi_console/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/swi_console/Makefile" ;;
"packages/Makefile.defs") CONFIG_FILES="$CONFIG_FILES packages/Makefile.defs" ;;
"packages/Dialect.defs") CONFIG_FILES="$CONFIG_FILES packages/Dialect.defs" ;;
"packages/CLPBN/Makefile") CONFIG_FILES="$CONFIG_FILES packages/CLPBN/Makefile" ;;
@ -12253,6 +12253,9 @@ do
"packages/meld/Makefile") CONFIG_FILES="$CONFIG_FILES packages/meld/Makefile" ;;
"packages/xml/Makefile") CONFIG_FILES="$CONFIG_FILES packages/xml/Makefile" ;;
"packages/ProbLog/Makefile") CONFIG_FILES="$CONFIG_FILES packages/ProbLog/Makefile" ;;
"swi/console/Makefile") CONFIG_FILES="$CONFIG_FILES swi/console/Makefile" ;;
"swi/library/Makefile") CONFIG_FILES="$CONFIG_FILES swi/library/Makefile" ;;
"swi/library/clp/Makefile") CONFIG_FILES="$CONFIG_FILES swi/library/clp/Makefile" ;;
"packages/chr/Makefile") CONFIG_FILES="$CONFIG_FILES packages/chr/Makefile" ;;
"packages/clib/Makefile") CONFIG_FILES="$CONFIG_FILES packages/clib/Makefile" ;;
"packages/clib/maildrop/rfc822/Makefile") CONFIG_FILES="$CONFIG_FILES packages/clib/maildrop/rfc822/Makefile" ;;

24
configure.in
View File

@ -1154,6 +1154,9 @@ elif test -e "$srcdir"/packages/jpl/Makefile.in; then
JAVAC=$yap_cv_java/bin/javac
JAVADOC=$yap_cv_java/bin/javadoc
fi
if test "x$JAVACFLAGS" = x; then
JAVACFLAGS="-source 1.4 -target 1.4"
fi
else
ENABLE_JPL="@#"
fi
@ -1227,14 +1230,13 @@ case "$target_os" in
then
YAPLIB_LD="\$(CC) -shared"
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
INSTALL_ENV="LD_LIBRARY_PATH=:\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
else
YAPLIB_LD="\$(CC)"
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
INSTALL_ENV="YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
PRE_INSTALL_ENV=""
fi
PRE_INSTALL_ENV="LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$(abs_top_builddir):\$(abs_top_builddir)/lib/sys"
;;
*sunos4*)
M4="/usr/5bin/m4"
@ -1850,6 +1852,7 @@ AC_SUBST(JAVA)
AC_SUBST(JAVA_HOME)
AC_SUBST(JUNIT)
AC_SUBST(JAVAC)
AC_SUBST(JAVACFLAGS)
AC_SUBST(JAVADOC)
AC_SUBST(JAR)
AC_SUBST(LIBJPL)
@ -2480,9 +2483,7 @@ mkdir -p library/regex
mkdir -p library/system
mkdir -p library/tries
mkdir -p library/rltree
mkdir -p LGPL/clp
mkdir -p LGPL/swi_console
mkdir -p GPL
mkdir -p LGPL
mkdir -p packages/
mkdir -p packages/bdd
mkdir -p packages/clib
@ -2531,9 +2532,12 @@ mkdir -p packages/sgml
mkdir -p packages/xml
mkdir -p packages/zlib
mkdir -p packages/archive
mkdir -p swi
mkdir -p swi/console
mkdir -p swi/library
mkdir -p swi/library/clp
AC_CONFIG_FILES([Makefile])
AC_CONFIG_FILES([GPL/Makefile])
AC_CONFIG_FILES([library/Makefile])
AC_CONFIG_FILES([library/lammpi/Makefile])
AC_CONFIG_FILES([library/matlab/Makefile])
@ -2544,9 +2548,6 @@ AC_CONFIG_FILES([library/regex/Makefile])
AC_CONFIG_FILES([library/rltree/Makefile])
AC_CONFIG_FILES([library/system/Makefile])
AC_CONFIG_FILES([library/tries/Makefile])
AC_CONFIG_FILES([LGPL/Makefile])
AC_CONFIG_FILES([LGPL/clp/Makefile])
AC_CONFIG_FILES([LGPL/swi_console/Makefile])
AC_CONFIG_FILES([packages/Makefile.defs])
AC_CONFIG_FILES([packages/Dialect.defs])
AC_CONFIG_FILES([packages/CLPBN/Makefile])
@ -2556,6 +2557,9 @@ AC_CONFIG_FILES([packages/cplint/slipcase/Makefile])
AC_CONFIG_FILES([packages/meld/Makefile])
AC_CONFIG_FILES([packages/xml/Makefile])
AC_CONFIG_FILES([packages/ProbLog/Makefile ])
AC_CONFIG_FILES([swi/console/Makefile])
AC_CONFIG_FILES([swi/library/Makefile])
AC_CONFIG_FILES([swi/library/clp/Makefile])
if test "$ENABLE_CHR" = ""; then
AC_CONFIG_FILES([packages/chr/Makefile])

2
console/yap.c
View File

@ -166,7 +166,7 @@ main (int argc, char **argv)
YAP_RunGoalOnce(t_goal);
}
}
YAP_ClearExceptions();
YAP_Reset();
/* End preprocessor code */
exec_top_level(BootMode, &init_args);

9
docs/yap.tex
View File

@ -3378,7 +3378,7 @@ Succeeds if there are no free variables in the term @var{T}.
@findex acyclic_term/1
@snindex acyclic_term/1
@cnindex acyclic_term/1
Succeeds if there are loops in the term @var{T}, that is, it is an infite term.
Succeeds if there are loops in the term @var{T}, that is, it is an infinite term.
@item arg(+@var{N},+@var{T},@var{A}) [ISO]
@findex arg/3
@ -12840,6 +12840,13 @@ vertices in @var{Vs} map to vertices in @var{NewVs}.
The path @var{Path} is a path starting at vertex @var{Vertex} in graph
@var{Graph}.
@item dgraph_path(+@var{Vertex}, +@var{Vertex1}, +@var{Graph}, ?@var{Path})
@findex dgraph_path/3
@snindex dgraph_path/3
@cnindex dgraph_path/3
The path @var{Path} is a path starting at vertex @var{Vertex} in graph
@var{Graph} and ending at path @var{Vertex2}.
@item dgraph_reachable(+@var{Vertex}, +@var{Graph}, ?@var{Edges})
@findex dgraph_path/3
@snindex dgraph_path/3

4
include/YapInterface.h
View File

@ -274,6 +274,8 @@ extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *));
/* int YAP_RunGoal(YAP_Term) */
extern X_API YAP_Int PROTO(YAP_RunGoal,(YAP_Term));
extern X_API YAP_Int PROTO(YAP_RunPredicate,(YAP_PredEntryPtr, YAP_Term *));
/* int YAP_RunGoalOnce(YAP_Term) */
extern X_API YAP_Int PROTO(YAP_RunGoalOnce,(YAP_Term));
@ -288,7 +290,7 @@ extern X_API YAP_Bool PROTO(YAP_ContinueGoal,(void));
/* void YAP_PruneGoal(void) */
extern X_API void PROTO(YAP_PruneGoal,(void));
extern X_API void PROTO(YAP_PruneGoal,(YAP_dogoalinfo *));
/* int YAP_FunctorToPred(struct pred_entry *, YAP_Term *) */
extern X_API YAP_PredEntryPtr PROTO(YAP_FunctorToPred,(YAP_Functor));

2
include/yap_structs.h
View File

@ -229,7 +229,7 @@ typedef struct YAP_pred_entry *YAP_PredEntryPtr;
/* this should be opaque to the user */
typedef struct {
unsigned long b;
struct yami *p;
struct yami *p, *cp;
} YAP_dogoalinfo;
typedef int (*YAP_agc_hook)(void *_Atom);

28
library/dgraphs.yap
View File

@ -32,6 +32,7 @@
dgraph_min_paths/3,
dgraph_isomorphic/4,
dgraph_path/3,
dgraph_path/4,
dgraph_leaves/2,
dgraph_reachable/3
]).
@ -40,7 +41,8 @@
[rb_new/1 as dgraph_new]).
:- use_module(library(rbtrees),
[rb_empty/1,
[rb_new/1,
rb_empty/1,
rb_lookup/3,
rb_apply/4,
rb_insert/4,
@ -361,10 +363,21 @@ dgraph_min_paths(V1, Graph, Paths) :-
dgraph_to_wdgraph(Graph, WGraph),
wdgraph_min_paths(V1, WGraph, Paths).
dgraph_path(V, G, [V|P]) :-
rb_lookup(V, Children, G),
ord_del_element(Children, V, Ch),
do_path(Ch, G, [V], P).
dgraph_path(V1, V2, Graph, Path) :-
rb_new(E0),
rb_lookup(V1, Children, Graph),
dgraph_path_children(Children, V2, E0, Graph, Path).
dgraph_path_children([V1|_], V2, _E1, _Graph, []) :- V1 == V2.
dgraph_path_children([V1|_], V2, E1, Graph, [V1|Path]) :-
V2 \== V1,
\+ rb_lookup(V1, _, E0),
rb_insert(E0, V2, [], E1),
rb_lookup(V1, Children, Graph),
dgraph_path_children(Children, V2, E1, Graph, Path).
dgraph_path_children([_|Children], V2, E1, Graph, Path) :-
dgraph_path_children(Children, V2, E1, Graph, Path).
do_path([], _, _, []).
do_path([C|Children], G, SoFar, Path) :-
@ -378,6 +391,11 @@ do_children([V|_], G, SoFar, [V|Path]) :-
do_children([_|Children], G, SoFar, Path) :-
do_children(Children, G, SoFar, Path).
dgraph_path(V, G, [V|P]) :-
rb_lookup(V, Children, G),
ord_del_element(Children, V, Ch),
do_path(Ch, G, [V], P).
dgraph_isomorphic(Vs, Vs2, G1, G2) :-
rb_new(Map0),

4
library/dialect/swi.yap
View File

@ -203,8 +203,9 @@ convert_time(Stamp, Y, Mon, Day, Hour, Min, Sec, MilliSec) :-
Sec is integer(float_integer_part(FSec)),
MilliSec is integer(float_fractional_part(FSec)*1000).
compile_aux_clauses([]).
compile_aux_clauses([(:- G)|Cls]) :-
compile_aux_clauses([(:- G)|Cls]) :- !,
prolog_load_context(module, M),
once(M:G),
compile_aux_clauses(Cls).
@ -213,6 +214,7 @@ compile_aux_clauses([Cl|Cls]) :-
assert_static(M:Cl),
compile_aux_clauses(Cls).
'$set_predicate_attribute'(_, _, _).
flag(Key, Old, New) :-

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

@ -109,23 +109,6 @@ Yap_InitSWIHash(void)
}
}
static void
PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m)
{
PredEntry *pd = (PredEntry *)p;
if (pd->ArityOfPE) {
*arity = pd->ArityOfPE;
*a = NameOfFunctor(pd->FunctorOfPred);
} else {
*arity = 0;
*a = (Atom)(pd->FunctorOfPred);
}
if (pd->ModuleOfPred)
*m = pd->ModuleOfPred;
else
*m = TermProlog;
}
static void
UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int flags)
{
@ -2198,7 +2181,7 @@ PL_open_foreign_frame(void)
open_query *new = (open_query *)malloc(sizeof(open_query));
if (!new) return 0;
new->old = LOCAL_execution;
new->g = TermNil;
new->g = NULL;
new->open = FALSE;
new->cp = CP;
new->p = P;
@ -2245,7 +2228,6 @@ backtrack(void)
CACHE_REGS
P = FAILCODE;
Yap_absmi(0);
H = HB = B->cp_h;
TR = B->cp_tr;
}
@ -2291,16 +2273,16 @@ PL_discard_foreign_frame(fid_t f)
X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
{
CACHE_REGS
Atom yname;
unsigned long int arity;
Term t[2], m;
YAP_Term *t = NULL;
if (t0)
t = Yap_AddressFromSlot(t0 PASS_REGS);
/* ignore flags and module for now */
if (!LOCAL_execution) {
open_query *new = (open_query *)malloc(sizeof(open_query));
if (!new) return 0;
new->old = LOCAL_execution;
new->g = TermNil;
new->g = NULL;
new->open = FALSE;
new->cp = CP;
new->p = P;
@ -2312,31 +2294,8 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
LOCAL_execution->open=1;
LOCAL_execution->state=0;
LOCAL_execution->flags = flags;
PredicateInfo((PredEntry *)p, &yname, &arity, &m);
t[0] = SWIModuleToModule(ctx);
if (arity == 0) {
t[1] = MkAtomTerm(yname);
} else {
Functor f = Yap_MkFunctor(yname, arity);
t[1] = Yap_MkApplTerm(f,arity,Yap_AddressFromSlot(t0 PASS_REGS));
}
if (ctx) {
Term ti;
t[0] = MkAtomTerm((Atom)ctx);
ti = Yap_MkApplTerm(FunctorModule,2,t);
t[0] = ti;
LOCAL_execution->g = Yap_MkApplTerm(FunctorCall,1,t);
} else {
if (m && m != CurrentModule) {
Term ti;
t[0] = m;
ti = Yap_MkApplTerm(FunctorModule,2,t);
t[0] = ti;
LOCAL_execution->g = Yap_MkApplTerm(FunctorCall,1,t);
} else {
LOCAL_execution->g = t[1];
}
}
LOCAL_execution->pe = (PredEntry *)p;
LOCAL_execution->g = t;
return LOCAL_execution;
}
@ -2348,13 +2307,14 @@ X_API int PL_next_solution(qid_t qi)
if (setjmp(LOCAL_execution->env))
return 0;
if (qi->state == 0) {
result = YAP_RunGoal(qi->g);
result = YAP_EnterGoal((YAP_PredEntryPtr)qi->pe, qi->g, &qi->h);
} else {
LOCAL_AllowRestart = qi->open;
result = YAP_RestartGoal();
result = YAP_RetryGoal(&qi->h);
}
qi->state = 1;
if (result == 0) {
YAP_LeaveGoal(FALSE, &qi->h);
qi->open = 0;
}
return result;
@ -2363,8 +2323,7 @@ X_API int PL_next_solution(qid_t qi)
X_API void PL_cut_query(qid_t qi)
{
if (qi->open != 1 || qi->state == 0) return;
YAP_PruneGoal();
YAP_cut_up();
YAP_LeaveGoal(FALSE, &qi->h);
qi->open = 0;
}
@ -2379,16 +2338,17 @@ X_API void PL_close_query(qid_t qi)
if (qi->open != 1 || qi->state == 0) {
return;
}
YAP_PruneGoal();
YAP_RestartGoal();
YAP_LeaveGoal(FALSE, &qi->h);
qi->open = 0;
}
X_API int PL_call_predicate(module_t ctx, int flags, predicate_t p, term_t t0)
{
fid_t f = PL_open_foreign_frame();
qid_t qi = PL_open_query(ctx, flags, p, t0);
int ret = PL_next_solution(qi);
PL_cut_query(qi);
PL_close_foreign_frame(f);
return ret;
}
@ -2507,7 +2467,7 @@ X_API int PL_thread_self(void)
#if THREADS
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
return -1;
return worker_id;
return (worker_id+1)<<3;
#else
return -2;
#endif
@ -2521,9 +2481,22 @@ X_API int PL_unify_thread_id(term_t t, int i)
}
static int
pl_thread_self(void)
{
CACHE_REGS
#if THREADS
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
return -1;
return worker_id;
#else
return -2;
#endif
}
X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr)
{
int wid = PL_thread_self();
int wid = pl_thread_self();
if (wid < 0) {
/* we do not have an engine */
@ -2552,7 +2525,7 @@ X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr)
X_API int PL_thread_destroy_engine(void)
{
int wid = PL_thread_self();
int wid = pl_thread_self();
if (wid < 0) {
/* we do not have an engine */
@ -2610,7 +2583,7 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old)
{
CACHE_REGS
#if THREADS
int cwid = PL_thread_self(), nwid;
int cwid = pl_thread_self(), nwid;
if (cwid >= 0) {
if (old) *old = (PL_engine_t)(Yap_local[cwid]);
}

4
library/dialect/swi/fli/swi.h
View File

@ -45,11 +45,13 @@ void Yap_install_blobs(void);
typedef struct open_query_struct {
int open;
int state;
YAP_Term g;
YAP_Term *g;
PredEntry *pe;
yamop *p, *cp;
Int slots, b;
jmp_buf env;
int flags;
YAP_dogoalinfo h;
struct open_query_struct *old;
} open_query;

70
library/system.yap
View File

@ -88,7 +88,77 @@ check_int(I, Inp) :-
throw(error(type_error(integer,I),Inp)).
% file operations
% file operations
delete_file(IFile) :-
true_file_name(IFile, File),
delete_file(File, off, on, off).
delete_file(IFile, Opts) :-
true_file_name(IFile, File),
process_delete_file_opts(Opts, Dir, Recurse, Ignore, delete_file(File,Opts)),
delete_file(File, Dir, Recurse, Ignore).
process_delete_file_opts(V, _, _, _, T) :- var(V), !,
throw(error(instantiation_error,T)).
process_delete_file_opts([], off, off, off, _) :- !.
process_delete_file_opts([V|_], _, _, _, T) :- var(V), !,
throw(error(instantiation_error,T)).
process_delete_file_opts([directory|Opts], on, Recurse, Ignore, T) :- !,
process_delete_file_opts(Opts, _, Recurse, Ignore, T).
process_delete_file_opts([recursive|Opts], Dir, on, Ignore, T) :- !,
process_delete_file_opts(Opts, Dir, _, Ignore, T).
process_delete_file_opts([ignore|Opts], Dir, Recurse, on, T) :- !,
process_delete_file_opts(Opts, Dir, Recurse, _, T).
process_delete_file_opts(Opts, _, _, _, T) :-
throw(error(domain_error(delete_file_option,Opts),T)).
delete_file(IFile, Dir, Recurse, Ignore) :-
true_file_name(IFile, File),
file_property(File, Type, _, _, _Permissions, _, Ignore),
delete_file(Type, File, Dir, Recurse, Ignore).
delete_file(N, File, _Dir, _Recurse, Ignore) :- number(N), !, % error.
handle_system_error(N, Ignore, delete_file(File)).
delete_file(directory, File, Dir, Recurse, Ignore) :-
delete_directory(Dir, File, Recurse, Ignore), !.
delete_file(_, File, _Dir, _Recurse, Ignore) :-
unlink_file(File, Ignore).
unlink_file(IFile, Ignore) :-
true_file_name(IFile, File),
unlink(File, N),
handle_system_error(N, Ignore, delete_file(File)).
delete_directory(on, File, _Recurse, Ignore) :-
rm_directory(File, Ignore).
delete_directory(off, File, Recurse, Ignore) :-
delete_directory(Recurse, File, Ignore).
rm_directory(File, Ignore) :-
rmdir(File, Error),
handle_system_error(Error, Ignore, delete_file(File)).
delete_directory(on, File, Ignore) :-
directory_files(File, FileList, Ignore),
path_separator(D),
atom_concat(File, D, FileP),
delete_dirfiles(FileList, FileP, Ignore),
rmdir(File, Ignore).
delete_dirfiles([], _, _).
delete_dirfiles(['.'|Fs], File, Ignore) :- !,
delete_dirfiles(Fs, File, Ignore).
delete_dirfiles(['..'|Fs], File, Ignore) :- !,
delete_dirfiles(Fs, File, Ignore).
delete_dirfiles([F|Fs], File, Ignore) :-
atom_concat(File,F,TrueF),
delete_file(TrueF, off, on, Ignore),
delete_dirfiles(Fs, File, Ignore).
directory_files(File, FileList, Ignore) :-
list_directory(File, FileList, Error),
handle_system_error(Error, Ignore, directory_files(File, FileList)).
handle_system_error(Error, _Ignore, _G) :- var(Error), !.
handle_system_error(Error, off, G) :- atom(Error), !,

17
misc/GLOBALS
View File

@ -120,6 +120,23 @@ char pwd[YAP_FILENAME_MAX] void
char* RestoreFile void
//gprof.c
Int ProfCalls void
Int ProfGCs void
Int ProfHGrows void
Int ProfSGrows void
Int ProfMallocs void
Int ProfIndexing void
Int ProfOn void
Int ProfOns void
struct RB_red_blk_node* ProfilerRoot void
struct RB_red_blk_node* ProfilerNil void
char* DIRNAME =NULL
#if LOW_PROF
int ProfilerOn =FALSE
FILE* FProf =NULL
FILE* FPreds =NULL
#endif /* LOW_PROF */
END_GLOBAL_DATA

18
misc/LOCALS
View File

@ -199,6 +199,7 @@ struct db_globs* s_dbg void
//eval.c
yap_error_number matherror =YAP_NO_ERROR
yap_error_number CurrentError =YAP_NO_ERROR
//grow.c
int heap_overflows =0
@ -251,23 +252,6 @@ UInt ImportDBRefHashTableSize =0
UInt ImportDBRefHashTableNum =0
yamop *ImportFAILCODE =NULL
//gprof.c
Int ProfCalls void
Int ProfGCs void
Int ProfHGrows void
Int ProfSGrows void
Int ProfMallocs void
Int ProfIndexing void
Int ProfOn void
Int ProfOns void
struct RB_red_blk_node* ProfilerRoot void
struct RB_red_blk_node* ProfilerNil void
char* DIRNAME =NULL
#if LOW_PROF
int ProfilerOn =FALSE
FILE* FProf =NULL
FILE* FPreds =NULL
#endif /* LOW_PROF */
Functor FunctorVar =FunctorVar

4
os/pl-files.c
View File

@ -828,7 +828,7 @@ PRED_IMPL("tmp_file_stream", 3, tmp_file_stream, 0)
static
PRED_IMPL("delete_file", 1, delete_file, 0)
PRED_IMPL("swi_delete_file", 1, delete_file, 0)
{ PRED_LD
char *n;
atom_t aname;
@ -1125,7 +1125,7 @@ BeginPredDefs(files)
PRED_DEF("exists_directory", 1, exists_directory, 0)
PRED_DEF("tmp_file", 2, tmp_file, 0)
PRED_DEF("tmp_file_stream", 3, tmp_file_stream, 0)
PRED_DEF("delete_file", 1, delete_file, 0)
PRED_DEF("swi_delete_file", 1, delete_file, 0)
PRED_DEF("delete_directory", 1, delete_directory, 0)
PRED_DEF("make_directory", 1, make_directory, 0)
PRED_DEF("same_file", 2, same_file, 0)

5
os/pl-write.c
View File

@ -184,8 +184,9 @@ bind_varnames(term_t varnames ARG_LD)
t1 = ArgOfTerm(1, tl);
t2 = ArgOfTerm(2, tl);
tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1);
if (!Yap_unify(t2, tv))
return FALSE;
if (IsVarTerm(t2)) {
Bind_and_Trail(VarOfTerm(t2), tv);
}
t = TailOfTerm(t);
}
return TRUE;

4
packages/ProbLog/problog_lbdd.yap
View File

@ -12,9 +12,9 @@ problog_kbest_bdd(Goal, K, Prob, ok) :-
bind_maplist(MapList, BoundVars),
bdd_to_probability_sum_product(BDD, BoundVars, Prob).
problog_kbest_as_bdd(Goal, K, bdd(Tree, MapList)) :-
problog_kbest_as_bdd(Goal, K, bdd(Dir, Tree, MapList)) :-
problog_kbest_to_bdd(Goal, K, BDD, MapList),
bdd_tree(BDD, bdd(_Dir, Tree, _Vars)),
bdd_tree(BDD, bdd(Dir, Tree, _Vars)),
bdd_close(BDD).
problog_kbest_to_bdd(Goal, K, BDD, MapList) :-

265
packages/ProbLog/problog_learning_lbdd.yap
View File

@ -362,7 +362,7 @@ reset_learning :-
retractall(current_iteration(_)),
retractall(example_count(_)),
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_)),
retractall(query_gradient_intern(_,_,_,_)),
retractall(last_mse(_)),
retractall(query_is_similar(_,_)),
retractall(query_md5(_,_,_)),
@ -581,7 +581,7 @@ init_learning :-
empty_bdd_directory :-
current_key(_,I),
integer(I),
recorded(I,bdd(_,_),R),
recorded(I,bdd(_,_,_),R),
erase(R),
fail.
empty_bdd_directory.
@ -615,13 +615,14 @@ init_one_query(QueryID,Query,Type) :-
format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID]);
(
problog_flag(libbdd_init_method,(Query,Bdd,Call)),
Bdd = bdd(Tree, MapList),
Bdd = bdd(Dir, Tree, MapList),
once(Call),
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
% writeln(Dir:Tree:MapList),
tree_to_grad(Tree, Hash, [], Grad),
%% %writeln(Call:Tree),
recordz(QueryID,bdd(Grad,MapList),_)
recordz(QueryID,bdd(Dir, Grad, MapList),_)
)
),
@ -706,17 +707,21 @@ get_prob(Node, Prob) :-
gradient(QueryID, l, Slope) :-
/* query_probability(21,6.775948e-01). */
recorded(QueryID, bdd(Tree, MapList), _),
recorded(QueryID, bdd(Dir, Tree, MapList), _),
bind_maplist(MapList),
run_sp(Tree, Slope, 0.0, Prob),
run_sp(Tree, Slope, 1.0, Prob0),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0),
%writeln(QueryID:Prob),
assert(query_probability_intern(QueryID,Prob)),
fail.
gradient(_QueryID, l, _).
gradient(QueryID, g, Slope) :-
recorded(QueryID, bdd(Tree, MapList), _),
recorded(QueryID, bdd(Dir, Tree, MapList), _),
bind_maplist(MapList),
member(I-_, MapList),
run_grad(Tree, I, Slope, 0.0, Grad),
run_grad(Tree, I, Slope, 0.0, Grad0),
( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0),
% writeln(grad(QueryID:I:Grad)),
assert(query_gradient_intern(QueryID,I,p,Grad)),
fail.
gradient(QueryID, g, Slope) :-
@ -732,7 +737,6 @@ tree_to_grad([Node|Tree], H, Grad0, Grad) :-
node_to_gradient_node(Node, H, GNode),
tree_to_grad(Tree, H, [GNode|Grad0], Grad).
/* pp should never happen */
node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :-
rb_lookup(X,Id,H),
(L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL),
@ -744,28 +748,27 @@ node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :-
run_sp([], _, P0, P0).
run_sp(gnodep(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
P is (PL / (1.0 + exp(-X * Slope)))+
(PR / (1.0 + exp(X * Slope))),
EP = 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL+ (1.0-EP)*PR,
run_sp(Tree, Slope, P, PF).
run_sp(gnoden(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
P is (PL / (1.0 + exp(-X * Slope)))+
((1-PR) / (1.0 + exp(X * Slope))),
EP is 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL + (1.0-EP)*(1.0 - PR),
run_sp(Tree, Slope, P, PF).
run_grad([], _I, _, G0, G0).
run_grad([gnodep(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
P is (PL / (1.0 + exp(-X * Slope)))+
(PR / (1.0 + exp(X * Slope))),
G0 is (GL / (1.0 + exp(-X * Slope)))+
(GR / (1.0 + exp(X * Slope))),
( I == Id -> G is G0+(PL-PR)*(1.0 / (1.0 + exp(-X * Slope)))*(1.0 / (1.0 + exp(X * Slope))) ; G = G0 ),
EP is 1.0/(1.0 + exp(-X * Slope)),
P is EP*PL+ (1.0-EP)*PR,
G0 is EP*GL + (1.0-EP)*GR,
% don' t forget the -X
( I == Id -> G is G0+(PL-PR)* EP*(1-EP)*Slope ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
run_grad([gnoden(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
P is (PL / (1.0 + exp(-X * Slope)))+
((1-PR) / (1.0 + exp(X * Slope))),
G0 is (GL / (1.0 + exp(-X * Slope)))-
(-GR / (1.0 + exp(X * Slope))),
( I == Id -> G is G0+(PL-(1-PR))*(1.0 / (1.0 + exp(-X * Slope)))*(1.0 / (1.0 + exp(X * Slope))) ; G = G0 ),
EP is 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL + (1.0-EP)*(1.0 - PR),
G0 is EP*GL - (1.0 - EP) * GR,
( I == Id -> G is G0+(PL+PR-1)*EP*(1-EP)*Slope ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
@ -1065,7 +1068,8 @@ add_gradient(Learning_Rate) :-
bb_get(Key2,GradValue),
inv_sigmoid(OldProbability,OldValue),
NewValue is OldValue -Learning_Rate*GradValue,
%writeln(FactID:OldValue +Learning_Rate*GradValue),
NewValue is OldValue +Learning_Rate*GradValue,
sigmoid(NewValue,NewProbability),
% Prevent "inf" by using values too close to 1.0
@ -1079,7 +1083,6 @@ add_gradient(Learning_Rate) :-
% vsc: avoid silly search
gradient_descent :-
continuous_fact(_), !,
current_iteration(Iteration),
create_training_predictions_file_name(Iteration,File_Name),
open(File_Name,'write',Handle),
@ -1171,11 +1174,21 @@ gradient_descent :-
( % go over all tunable facts
tunable_fact(FactID,_),
(
continuous_fact(FactID)
->
(
query_gradient(QueryID,FactID,p,GradValue),
atomic_concat(['grad_',FactID],Key),
% if the following query fails,
% it means, the fact is not used in the proof
% of QueryID, and the gradient is 0.0 and will
% not contribute to NewValue either way
% DON'T FORGET THIS IF YOU CHANGE SOMETHING HERE!
%writeln(u:QueryID:FactID:Y:GradValue),
bb_get(Key,OldValue),
NewValue is OldValue - Y*GradValue,
bb_put(Key,NewValue),
fail; % go to next fact
true
),
( continuous_fact(FactID),
atomic_concat(['grad_mu_',FactID],Key),
atomic_concat(['grad_sigma_',FactID],Key2),
@ -1194,26 +1207,11 @@ gradient_descent :-
NewValueSigma is OldValueSigma + Y*GradValueSigma,
bb_put(Key,NewValueMu),
bb_put(Key2,NewValueSigma)
);
(
atomic_concat(['grad_',FactID],Key),
% if the following query fails,
% it means, the fact is not used in the proof
% of QueryID, and the gradient is 0.0 and will
% not contribute to NewValue either way
% DON'T FORGET THIS IF YOU CHANGE SOMETHING HERE!
query_gradient(QueryID,FactID,p,GradValue),
bb_get(Key,OldValue),
NewValue is OldValue + Y*GradValue,
bb_put(Key,NewValue)
)
),
fail; % go to next fact
true
),
bb_put(Key2,NewValueSigma),
fail
;
true
),
once(update_query_cleanup(QueryID))
)),
@ -1232,7 +1230,6 @@ gradient_descent :-
atomic_concat(['grad_',FactID],Key),
bb_get(Key,V)
),Gradient_Values),
(
Gradient_Values==[]
->
@ -1288,172 +1285,6 @@ gradient_descent :-
!,
forget_old_probabilities.
% VSC: no continuous facts
% simplify code
gradient_descent :-
current_iteration(Iteration),
create_training_predictions_file_name(Iteration,File_Name),
open(File_Name,'write',Handle),
format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]),
format(Handle,"% Iteration, train/test, QueryID, Query, GroundTruth, Prediction %~n",[]),
format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]),
format_learning(2,'Gradient ',[]),
save_old_probabilities,
update_values,
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start set gradient to zero
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
forall(tunable_fact(FactID,_),
(
(
atomic_concat(['grad_',FactID],Key),
bb_put(Key,0.0)
)
)
),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop gradient to zero
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
bb_put(mse_train_sum, 0.0),
bb_put(mse_train_min, 0.0),
bb_put(mse_train_max, 0.0),
bb_put(llh_training_queries, 0.0),
problog_flag(alpha,Alpha),
logger_set_variable(alpha,Alpha),
example_count(Example_Count),
forall(user:example(QueryID,Query,QueryProb,Type),
(
once(update_query(QueryID,'.',all)),
query_probability(QueryID,BDDProb),
format(Handle,'ex(~q,train,~q,~q,~10f,~10f).~n',[Iteration,QueryID,Query,QueryProb,BDDProb]),
(
QueryProb=:=0.0
->
Y2=Alpha;
Y2=1.0
),
(
(Type == '='; (Type == '<', BDDProb>QueryProb); (Type=='>',BDDProb<QueryProb))
->
Y is Y2*2/Example_Count * (BDDProb-QueryProb);
Y=0.0
),
% first do the calculations for the MSE on training set
(
(Type == '='; (Type == '<', BDDProb>QueryProb); (Type=='>',BDDProb<QueryProb))
->
Squared_Error is (BDDProb-QueryProb)**2;
Squared_Error=0.0
),
bb_get(mse_train_sum,Old_MSE_Train_Sum),
bb_get(mse_train_min,Old_MSE_Train_Min),
bb_get(mse_train_max,Old_MSE_Train_Max),
bb_get(llh_training_queries,Old_LLH_Training_Queries),
New_MSE_Train_Sum is Old_MSE_Train_Sum+Squared_Error,
New_MSE_Train_Min is min(Old_MSE_Train_Min,Squared_Error),
New_MSE_Train_Max is max(Old_MSE_Train_Max,Squared_Error),
New_LLH_Training_Queries is Old_LLH_Training_Queries+log(BDDProb),
bb_put(mse_train_sum,New_MSE_Train_Sum),
bb_put(mse_train_min,New_MSE_Train_Min),
bb_put(mse_train_max,New_MSE_Train_Max),
bb_put(llh_training_queries,New_LLH_Training_Queries),
( % go over all tunable facts
query_gradient(QueryID,FactID,p,GradValue),
atomic_concat(['grad_',FactID],Key),
bb_get(Key,OldValue),
NewValue is OldValue + Y*GradValue,
bb_put(Key,NewValue),
fail; % go to next fact
true
),
once(update_query_cleanup(QueryID))
)),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!,
close(Handle),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start statistics on gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
findall(V, (
tunable_fact(FactID,_),
atomic_concat(['grad_',FactID],Key),
bb_get(Key,V)
),Gradient_Values),
(
Gradient_Values==[]
->
(
logger_set_variable(gradient_mean,0.0),
logger_set_variable(gradient_min,0.0),
logger_set_variable(gradient_max,0.0)
);
(
sum_list(Gradient_Values,GradSum),
max_list(Gradient_Values,GradMax),
min_list(Gradient_Values,GradMin),
length(Gradient_Values,GradLength),
GradMean is GradSum/GradLength,
logger_set_variable(gradient_mean,GradMean),
logger_set_variable(gradient_min,GradMin),
logger_set_variable(gradient_max,GradMax)
)
),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop statistics on gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
bb_delete(mse_train_sum,MSE_Train_Sum),
bb_delete(mse_train_min,MSE_Train_Min),
bb_delete(mse_train_max,MSE_Train_Max),
bb_delete(llh_training_queries,LLH_Training_Queries),
MSE is MSE_Train_Sum/Example_Count,
logger_set_variable(mse_trainingset,MSE),
logger_set_variable(mse_min_trainingset,MSE_Train_Min),
logger_set_variable(mse_max_trainingset,MSE_Train_Max),
logger_set_variable(llh_training_queries,LLH_Training_Queries),
format_learning(2,'~n',[]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start add gradient to current probabilities
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(
problog_flag(line_search,false)
->
problog_flag(learning_rate,LearningRate);
lineSearch(LearningRate,_)
),
format_learning(3,'learning rate:~8f~n',[LearningRate]),
add_gradient(LearningRate),
logger_set_variable(learning_rate,LearningRate),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop add gradient to current probabilities
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!,
forget_old_probabilities.
%========================================================================
%=

2
packages/RDF

@ -1 +1 @@
Subproject commit 79a369f81a44a6cbf16d50351fbfbffc23f90f03
Subproject commit 9995994768d968c6059f255cd3077abdd34e61a1

4
packages/bdd/ddnnf.yap
View File

@ -27,8 +27,8 @@ mkddnnf(CNF, PVs, DDNNF) :-
close(S),
% execute c2d at this point, but we're lazy%
% unix(system('c2d -dt_method 3 -in dimacs')),
% unix(system('c2d -visualize -in dimacs')),
unix(system('dsharp -Fnnf dimacs.nnf dimacs')),
unix(system('c2d -visualize -in dimacs')),
% unix(system('dsharp -Fnnf dimacs.nnf dimacs')),
open('dimacs.nnf',read,R),
SVars =.. [v|AllVars],
% ones(LVars),

21
packages/bdd/trie_sp.yap
View File

@ -7,12 +7,15 @@
:- use_module(library(rbtrees)).
trie_to_bdd(Trie, BDD, MapList) :-
%trie_print(Trie),
trie_to_list(Trie, Complex),
%(numbervars(Complex,1,_), writeln(Complex), fail ; true ),
rb_new(Map0),
complex_to_andor(Complex,Map0,Map,Tree),
%numbervars(Tree,1,_), writeln(Tree), fail ; true ),
rb_visit(Map, MapList),
extract_vars(MapList, Vs),
bdd_new(Tree, Vs, BDD).
bdd_new(Tree, Vs, BDD). %writeln(BDD).
tabled_trie_to_bdd(Trie, BDD, MapList) :-
trie_to_list(Trie, Complex),
@ -43,12 +46,24 @@ complex_to_and(int(A1,[endlist]), Map0, MapF, V) :- !,
check(Map0, A1, V, MapF).
complex_to_and(functor(not,1,[int(A1,[endlist])]), Map0, MapF, not(V)) :- !,
check(Map0, A1, V, MapF).
complex_to_and(int(A1,Els), Map0, MapF, and(V,T2)) :-
complex_to_and(int(A1,Els), Map0, MapF, and(V,T2)) :- !,
check(Map0, A1, V, MapI),
complex_to_andor(Els, MapI, MapF, T2).
complex_to_and(functor(not,1,[int(A1,Els)]), Map0, MapF, and(not(V),T2)) :-
complex_to_and(functor(not,1,[int(A1,Els)]), Map0, MapF, and(not(V),T2)) :- !,
check(Map0, A1, V, MapI),
complex_to_andor(Els, MapI, MapF, T2).
% HASH TABLE, it can be an OR or an AND.
complex_to_and(functor(not,1,[int(A1,Els)|More]), Map0, MapF, or(NOTV1,O2)) :-
check(Map0, A1, V, MapI),
(Els == [endlist]
->
NOTV1 = not(V),
MapI = MapI2
;
complex_to_andor(Els, MapI, MapI2, T2),
NOTV1 = and(not(V), T2)
),
complex_to_and(functor(not,1,More), MapI2, MapF, O2).
tabled_complex_to_andor(T, Map, Map, Tab, Tab, V) :-
rb_lookup(T, V, Tab), !,

2
packages/chr

@ -1 +1 @@
Subproject commit d6fd44a4a8dbbb0bae9331c05191e12fc2727f1d
Subproject commit 8227ad57d54473b719d330632b8e3c5536776b71

2
packages/jpl

@ -1 +1 @@
Subproject commit 8b75ad1bed7cbdbb51516fd2b00209357d91c8c7
Subproject commit 8da0814be7adceb1f20cad7b84777674b110018b

2
packages/pldoc

@ -1 +1 @@
Subproject commit 9beecb39041e1faf95e5d2af257e7be8cdda467c
Subproject commit 1e324d30b913edbe78cc4b923cde7998013cbfb0

2
packages/real

@ -1 +1 @@
Subproject commit 4452ed66c995b13258d74144d64a9d9425f22e77
Subproject commit 0bcbe41017f90149434e6ae9a658bf7cd05f255f

2
packages/semweb

@ -1 +1 @@
Subproject commit 824213ecd9293aa89aace63bae7173a1f978bb0b
Subproject commit 3ed10e016db8d5f6c925f922c3d744dc10039f4a

2
packages/sgml

@ -1 +1 @@
Subproject commit 35502096430308b4bfd525b3118d19700c04ef8a
Subproject commit 18647f78aa21d494aceac0dcaaac6fc6699f0df0

2
packages/zlib

@ -1 +1 @@
Subproject commit 980a0b9950ca0b52b327234fd2f66e0790f9c4e1
Subproject commit d4bf3fc7816536a60d3b0ca0fd512b444a4a9b93

8
pl/arith.yap
View File

@ -37,10 +37,9 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$do_c_built_in'(G, M, OUT) :- var(G), !,
'$do_c_built_in'(call(G), M, OUT).
'$do_c_built_in'(Mod:G, _, GN) :- !,
'$do_c_built_in'(G, Mod, GN0),
(GN0 = (_,_) -> GN = GN0 ; GN = Mod:GN0).
'$do_c_built_metacall'(G, M, OUT).
'$do_c_built_in'(Mod:G, _, OUT) :- !,
'$do_c_built_metacall'(G, Mod, OUT).
'$do_c_built_in'(\+ G, _, OUT) :-
nonvar(G),
G = (A = B),
@ -87,6 +86,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$clean_cuts'(NG0, NG),
'$do_c_built_in'(A,M,NA).
'$do_c_built_in'('C'(A,B,C), _, (A=[B|C])) :- !.
'$do_c_built_in'(trace, _M, '$do_trace') :- !.
'$do_c_built_in'(X is Y, M, P) :-
primitive(X), !,
'$do_c_built_in'(X =:= Y, M, P).

9
pl/attributes.yap
View File

@ -148,6 +148,7 @@ lcall2([Goal|Goals], Mod) :-
prolog:call_residue_vars(Goal,Residue) :-
attributes:all_attvars(Vs0),
call(Goal),
'$stop_creeping',
attributes:all_attvars(Vs),
% this should not be actually strictly necessary right now.
% but it makes it a safe bet.
@ -216,14 +217,14 @@ attvar_residuals(att(Module,Value,As), V) -->
->
[]
;
{ '$notrace'(Module:attribute_goal(V, Goal)) },
{ call(Module:attribute_goal(V, Goal)) },
dot_list(Goal)
)
; ( { current_predicate(Module:attribute_goals/3) }
-> { '$notrace'(Module:attribute_goals(V, Goals, [])) },
-> { call(Module:attribute_goals(V, Goals, [])) },
list(Goals)
; { current_predicate(Module:attribute_goal/2) }
-> { '$notrace'(Module:attribute_goal(V, Goal)) },
-> { call(Module:attribute_goal(V, Goal)) },
dot_list(Goal)
; [put_attr(V, Module, Value)]
),
@ -312,7 +313,7 @@ pick_att_vars([_|L],NL) :-
project_module([], _, _).
project_module([Mod|LMods], LIV, LAV) :-
'$pred_exists'(project_attributes(LIV, LAV),Mod),
'$notrace'(Mod:project_attributes(LIV, LAV)), !,
call(Mod:project_attributes(LIV, LAV)), !,
attributes:all_attvars(NLAV),
project_module(LMods,LIV,NLAV).
project_module([_|LMods], LIV, LAV) :-

163
pl/boot.yap
View File

@ -168,10 +168,7 @@ true :- true.
prompt(_,'|: '),
'$system_catch'('$raw_read'(user_input, Line), prolog, E,
(print_message(error, E),
( E = error(syntax_error(_), _)
-> fail
; throw(E)
))),
'$handle_toplevel_error'(Line, E))),
(
current_predicate(_, user:rl_add_history(_))
->
@ -190,6 +187,10 @@ true :- true.
)
), !.
'$handle_toplevel_error'(_, syntax_error(_)) :- !, fail.
'$handle_toplevel_error'(end_of_file, error(io_error(read,user_input),_)) :- !.
'$handle_toplevel_error'(_, E) :-
throw(E).
% reset alarms when entering top-level.
'$enter_top_level' :-
@ -220,7 +221,6 @@ true :- true.
'$run_atom_goal'(GA),
( '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ).
'$enter_top_level' :-
'$disable_docreep',
'$run_toplevel_hooks',
prompt1(' ?- '),
'$read_toplevel'(Command,Varnames),
@ -378,9 +378,7 @@ true :- true.
% but YAP and SICStus does.
%
'$process_directive'(G, _, M, VL, Pos) :-
'$exit_system_mode',
( '$notrace'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ),
'$enter_system_mode'.
( '$execute'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
@ -488,26 +486,24 @@ true :- true.
'$yes_no'(G,(?-)).
'$query'(G,V) :-
(
yap_hacks:current_choice_point(CP),
'$exit_system_mode',
'$execute'(G),
yap_hacks:current_choice_point(NCP),
( '$enter_system_mode' ; '$exit_system_mode', fail),
'$current_choice_point'(CP),
'$current_module'(M),
'$execute_outside_system_mode'(G, M),
'$current_choice_point'(NCP),
'$delayed_goals'(G, V, NV, LGs, DCP),
'$write_answer'(NV, LGs, Written),
'$write_query_answer_true'(Written),
(
'$prompt_alternatives_on'(determinism), CP = NCP, DCP = 0 ->
nl(user_error),
'$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0
->
format(user_error, '.~n', []),
!
;
'$another',
!
),
fail
;
'$enter_system_mode',
'$out_neg_answer'
).
@ -517,12 +513,12 @@ true :- true.
'$delayed_goals'(G, [], NV, LGs, _),
'$write_answer'(NV, LGs, Written),
( Written = [] ->
!,'$present_answer'(C, yes);
'$another', !
!,'$present_answer'(C, true)
;
'$another', !
),
fail.
'$yes_no'(_,_) :-
'$enter_system_mode',
'$out_neg_answer'.
'$add_env_and_fail' :- fail.
@ -533,9 +529,9 @@ true :- true.
'$delayed_goals'(G, V, NV, LGs, NCP) :-
(
CP is '$last_choice_pt',
yap_hacks:current_choice_point(NCP1),
'$current_choice_point'(NCP1),
'$attributes':delayed_goals(G, V, NV, LGs),
yap_hacks:current_choice_point(NCP2),
'$current_choice_point'(NCP2),
'$clean_ifcp'(CP),
NCP is NCP2-NCP1
;
@ -546,20 +542,20 @@ true :- true.
'$out_neg_answer' :-
( '$undefined'(print_message(_,_),prolog) ->
'$present_answer'(user_error,"no~n", [])
'$present_answer'(user_error,'false.~n', [])
;
print_message(help,no)
print_message(help,false)
),
fail.
'$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
'$do_yes_no'([X|L], M) :-
!,
'$csult'([X|L], M).
'$do_yes_no'(G, M) :-
'$exit_system_mode',
'$execute'(M:G),
( '$enter_system_mode' ; '$exit_system_mode', fail).
'$execute_outside_system_mode'(G, M).
'$write_query_answer_true'([]) :- !,
format(user_error,'~ntrue',[]).
format(user_error,'true',[]).
'$write_query_answer_true'(_).
@ -579,7 +575,7 @@ true :- true.
write_term(user_error,Answ,Opts) ;
format(user_error,'~w',[Answ])
),
format(user_error,'~n', []).
format(user_error,'.~n', []).
'$another' :-
format(user_error,' ? ',[]),
@ -588,7 +584,7 @@ true :- true.
'$do_another'(C) :-
( C== 0'; -> skip(user_input,10), %'
'$add_nl_outside_console',
% '$add_nl_outside_console',
fail
;
C== 10 -> '$add_nl_outside_console',
@ -761,7 +757,7 @@ incore(G) :- '$execute'(G).
% standard meta-call, called if $execute could not do everything.
%
'$meta_call'(G, M) :-
yap_hacks:current_choice_point(CP),
'$current_choice_point'(CP),
'$call'(G, CP, G, M).
@ -783,7 +779,7 @@ incore(G) :- '$execute'(G).
yap_hacks:env_choice_point(CP),
'$current_module'(M),
(
yap_hacks:current_choicepoint(DCP),
yap_hacks:current_choice_point(DCP),
'$execute'(X),
yap_hacks:cut_at(DCP),
'$call'(A,CP,((X*->A),Y),M)
@ -816,7 +812,7 @@ not(G) :- \+ '$execute'(G).
%
'$meta_call'(G,_ISO,M) :-
'$iso_check_goal'(G,G),
yap_hacks:current_choice_point(CP),
'$current_choice_point'(CP),
'$call'(G, CP, G, M).
'$meta_call'(G, CP, G0, M) :-
@ -853,7 +849,7 @@ not(G) :- \+ '$execute'(G).
).
'$call'((X*->Y; Z),CP,G0,M) :- !,
(
yap_hacks:current_choicepoint(DCP),
'$current_choice_point'(DCP),
'$call'(X,CP,G0,M),
yap_hacks:cut_at(DCP),
'$call'(Y,CP,G0,M)
@ -876,7 +872,7 @@ not(G) :- \+ '$execute'(G).
).
'$call'((X*->Y| Z),CP,G0,M) :- !,
(
yap_hacks:current_choicepoint(DCP),
'$current_choice_point'(DCP),
'$call'(X,CP,G0,M),
yap_hacks:cut_at(DCP),
'$call'(Y,CP,G0,M)
@ -890,7 +886,7 @@ not(G) :- \+ '$execute'(G).
'$call'(B,CP,G0,M)
).
'$call'(\+ X, _CP, _G0, M) :- !,
yap_hacks:current_choicepoint(CP),
'$current_choice_point'(CP),
\+ '$call'(X,CP,G0,M).
'$call'(not(X), _CP, _G0, M) :- !,
\+ '$call'(X,CP,G0,M).
@ -1090,7 +1086,7 @@ bootstrap(F) :-
% support SWI hook in a separate predicate, to avoid slow down standard consult.
'$enter_command_with_hook'(Stream,Status) :-
'$read_vars'(Stream,Command,_,Pos,Vars, '|: ', Comments),
('$notrace'(prolog:comment_hook(Comments,Pos,Command)) -> true ; true ),
( prolog:comment_hook(Comments,Pos,Command) -> true ; true ),
'$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :-
@ -1167,9 +1163,9 @@ expand_term(Term,Expanded) :-
% where was the previous catch
catch(G, C, A) :-
'$catch'(C,A,_),
yap_hacks:current_choice_point(CP0),
'$$save_by'(CP0),
'$execute'(G),
yap_hacks:current_choice_point(CP1),
'$$save_by'(CP1),
(CP0 == CP1 -> !; true ).
% makes sure we have an environment.
@ -1184,9 +1180,9 @@ catch(G, C, A) :-
'$system_catch'(G, M, C, A) :-
% check current trail
'$catch'(C,A,_),
yap_hacks:current_choice_point(CP0),
'$$save_by'(CP0),
'$execute_nonstop'(G, M),
yap_hacks:current_choice_point(CP1),
'$$save_by'(CP1),
(CP0 == CP1 -> !; true ).
%
@ -1236,47 +1232,68 @@ catch_ball(C, C).
'$nb_getval'('$break', 0, fail),
recorded('$toplevel_hooks',H,_),
H \= fail, !,
( '$oncenotrace'(H) -> true ; true).
( call(user:H1) -> true ; true).
'$run_toplevel_hooks'.
'$enter_system_mode' :-
'$stop_creeping',
nb_setval('$system_mode',on).
'$in_system_mode' :-
'$nb_getval'('$system_mode',on,fail).
'$execute_outside_system_mode'(G,M) :-
CP is '$last_choice_pt',
'$execute_outside_system_mode'(G,M,CP).
'$execute_outside_system_mode'(V,M,_) :-
var(V), !,
call(M:G).
'$execute_outside_system_mode'(M:G, _M, CP) :- !,
'$execute_outside_system_mode'(G, M, CP).
'$execute_outside_system_mode'((G1,G2), M, CP) :- !,
'$execute_outside_system_mode'(G1, M, CP),
'$execute_outside_system_mode'(G2, M, CP).
'$execute_outside_system_mode'((G1;G2), M, CP) :- !,
(
'$execute_outside_system_mode'(G1, M, CP)
;
'$execute_outside_system_mode'(G2, M, CP)
).
'$execute_outside_system_mode'(G, M, CP) :-
nb_getval('$trace', on), !,
(
'$$save_by'(CP1),
'$do_spy'(G, M, CP, meta_creep),
% we may exit system mode...
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', fail ) ),
'$enter_system_mode'
;
'$enter_system_mode',
fail
).
'$execute_outside_system_mode'(G, M, CP) :-
(
'$$save_by'(CP1),
'$exit_system_mode',
'$execute_nonstop'(G,M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', fail ) ),
'$enter_system_mode'
;
'$enter_system_mode',
fail
).
'$exit_system_mode' :-
nb_setval('$system_mode',off),
( '$nb_getval'('$trace',on,fail) -> '$creep' ; true).
%
% just prevent creeping from going on...
%
'$notrace'(G) :-
'$disable_creep', !,
(
% creep was going on...
yap_hacks:current_choice_point(CP0),
'$execute'(G),
yap_hacks:current_choice_point(CP1),
( CP0 == CP1 ->
!,
'$creep'
;
(
'$creep'
;
'$disable_docreep',
fail
)
)
;
'$creep',
fail
).
'$notrace'(G) :-
'$execute'(G).
( '$nb_getval'('$trace',on,fail) -> '$meta_creep' ; true).
'$run_at_thread_start' :-
recorded('$thread_initialization',M:D,_),
'$notrace'(M:D),
'$execute_outside_sysem_mode'(D, M),
fail.
'$run_at_thread_start'.

55
pl/checker.yap
View File

@ -68,11 +68,11 @@
:- op(1150, fx, multifile).
style_check(V) :- var(V), !, fail.
style_check(all) :- '$syntax_check_mode'(_,on),
style_check(all) :-
'$syntax_check_single_var'(_,on),
'$syntax_check_discontiguous'(_,on),
'$syntax_check_multiple'(_,on).
style_check(single_var) :- '$syntax_check_mode'(_,on),
style_check(single_var) :-
'$syntax_check_single_var'(_,on).
style_check(singleton) :-
style_check(single_var).
@ -80,11 +80,11 @@ style_check(-single_var) :-
no_style_check(single_var).
style_check(-singleton) :-
no_style_check(single_var).
style_check(discontiguous) :- '$syntax_check_mode'(_,on),
style_check(discontiguous) :-
'$syntax_check_discontiguous'(_,on).
style_check(-discontiguous) :-
no_style_check(discontiguous).
style_check(multiple) :- '$syntax_check_mode'(_,on),
style_check(multiple) :-
'$syntax_check_multiple'(_,on).
style_check(-multiple) :-
no_style_check(multiple).
@ -92,31 +92,46 @@ style_check([]).
style_check([H|T]) :- style_check(H), style_check(T).
no_style_check(V) :- var(V), !, fail.
no_style_check(all) :- '$syntax_check_mode'(_,off),
no_style_check(all) :-
'$syntax_check_single_var'(_,off),
'$syntax_check_discontiguous'(_,off),
'$syntax_check_multiple'(_,off).
no_style_check(single_var) :- '$syntax_check_mode'(_,off),
no_style_check(single_var) :-
'$syntax_check_single_var'(_,off).
no_style_check(discontiguous) :- '$syntax_check_mode'(_,off),
no_style_check(discontiguous) :-
'$syntax_check_discontiguous'(_,off).
no_style_check(multiple) :- '$syntax_check_mode'(_,on),
no_style_check(multiple) :-
'$syntax_check_multiple'(_,off).
no_style_check([]).
no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$syntax_check_mode'(O,N) :-
'$values'('$syntaxcheckflag',O,N).
'$syntax_check_single_var'(O,N) :-
'$values'('$syntaxchecksinglevar',O,N).
'$values'('$syntaxchecksinglevar',O,N),
'$checking_on'.
'$syntax_check_discontiguous'(O,N) :-
'$values'('$syntaxcheckdiscontiguous',O,N).
'$values'('$syntaxcheckdiscontiguous',O,N),
'$checking_on'.
'$syntax_check_multiple'(O,N) :-
'$values'('$syntaxcheckmultiple',O,N).
'$values'('$syntaxcheckmultiple',O,N),
'$checking_on'.
%
% cases where you need to check a clause
%
'$checking_on' :-
(
get_value('$syntaxchecksinglevar',on)
;
get_value('$syntaxcheckdiscontiguous',on)
;
get_value('$syntaxcheckmultiple',on)
), !,
set_value('$syntaxcheckflag',on).
'$checking_on' :-
set_value('$syntaxcheckflag',off).
% reset current state of style checker.
'$init_style_check'(File) :-
@ -166,24 +181,24 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
%
'$singletons_in_clause'(T, VL, Sv) :-
% first check which variables are not singleton
'$non_singletons_in_term'(T,[],V2L),
'$non_singletons_in_term'(T, [], V2L),
% bound them
'$ground_vars'(V2L),
% the remainder which do not start by _ are our target!
'$sv_list'(VL, Sv).
'$ground_vars'([]).
'$ground_vars'(ground.V2L) :-
'$ground_vars'([ground|V2L]) :-
'$ground_vars'(V2L).
'$sv_list'([],[]).
'$sv_list'([[95|_]._|T],L) :- !,
'$sv_list'([(_=V)|T],L) :- nonvar(V), !,
'$sv_list'(T,L).
'$sv_list'([_|V].T,L) :- nonvar(V), !,
'$sv_list'([(X=_)|T], L) :-
atom_concat('_',_,X), !,
'$sv_list'(T,L).
'$sv_list'([Name|_].T, Name.L) :-
'$sv_list'([(Name=_)|T], [Name|L]) :-
'$sv_list'(T,L).
'$sv_warning'([], _) :- !.
'$sv_warning'(SVs, T) :-

8
pl/consult.yap
View File

@ -394,7 +394,7 @@ initialization(G,OPT) :-
'$do_error'(type_error(OPT),initialization(G,OPT))
).
'$initialization'(G,now) :-
( '$notrace'(G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
( call(G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
'$initialization'(G,after_load) :-
'$initialization'(G).
% ignore for now.
@ -412,7 +412,7 @@ initialization(G,OPT) :-
recorded('$system_initialisation',G,R),
erase(R),
G \= '$',
'$notrace'(G),
once( call(G) ),
fail.
'$exec_initialisation_goals' :-
'$show_consult_level'(Level),
@ -426,7 +426,7 @@ initialization(G,OPT) :-
( OldMode == on -> '$exit_system_mode' ; true ),
% run initialization under user control (so allow debugging this stuff).
(
'$system_catch'('$oncenotrace'(M:G), M, Error, user:'$LoopError'(Error, top)),
'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)),
fail
;
OldMode = on,
@ -895,7 +895,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
'$notrace'(user:file_search_path(Name, Dir)),
user:file_search_path(Name, Dir),
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
'$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :-

41
pl/control.yap
View File

@ -112,16 +112,15 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
throw(Exception).
'$safe_call_cleanup'(Goal, Cleanup, Catcher, Exception) :-
yap_hacks:current_choice_point(MyCP1),
'$current_choice_point'(MyCP1),
'$coroutining':freeze_goal(Catcher, '$clean_call'(Active, Cleanup)),
(
yap_hacks:trail_suspension_marker(Catcher),
yap_hacks:enable_interrupts,
yap_hacks:current_choice_point(CP0),
'$current_choice_point'(CP0),
'$execute'(Goal),
% ensure environment for delayed variables in Goal
'$true',
yap_hacks:current_choice_point(CPF),
'$stop_creeping',
'$current_choice_point'(CPF),
(
CP0 =:= CPF
->
@ -131,6 +130,7 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
true
)
;
'$stop_creeping',
Catcher = fail,
fail
).
@ -289,37 +289,6 @@ version(T) :-
fail.
'$set_toplevel_hook'(_).
'$oncenotrace'(G) :-
'$disable_creep', !,
(
'$execute'(G)
->
'$creep'
;
'$creep',
fail
).
'$oncenotrace'(G) :-
'$execute'(G), !.
'$once0'(G, M) :-
'$pred_exists'(G, M),
(
'$disable_creep'
->
(
'$execute_nonstop'(G, M)
->
'$creep'
;
'$creep',
fail
)
;
'$execute_nonstop'(G,M)
).
nb_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)

160
pl/debug.yap
View File

@ -123,21 +123,21 @@
recorded('$spy','$spy'(G,M),_), !.
spy Spec :-
'$notrace'(prolog:debug_action_hook(spy(Spec))), !.
prolog:debug_action_hook(spy(Spec)), !.
spy L :-
'$current_module'(M),
'$suspy'(L, spy, M), fail.
spy _ :- debug.
nospy Spec :-
'$notrace'(prolog:debug_action_hook(nospy(Spec))), !.
prolog:debug_action_hook(nospy(Spec)), !.
nospy L :-
'$current_module'(M),
'$suspy'(L, nospy, M), fail.
nospy _.
nospyall :-
'$notrace'(prolog:debug_action_hook(nospyall)), !.
prolog:debug_action_hook(nospyall), !.
nospyall :-
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
nospyall.
@ -170,6 +170,14 @@ nodebug :-
trace :-
nb_getval('$trace',on), !.
trace :-
nb_setval('$trace',on),
'$start_debugging'(on),
print_message(informational,debug(trace)),
'$meta_creep'.
'$do_trace' :-
nb_getval('$trace',on), !.
'$do_trace' :-
nb_setval('$trace',on),
'$start_debugging'(on),
print_message(informational,debug(trace)),
@ -283,45 +291,53 @@ debugging :-
'$debug_on'(F), F = false, !,
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :-
nb_getval('$system_mode',on), !,
'$in_system_mode', !,
'$exit_system_mode',
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :-
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, no).
'$enter_system_mode',
'$do_spy'(G, Mod, CP, spy).
% last argument to do_spy says that we are at the end of a context. It
% is required to know whether we are controlled by the debugger.
'$do_spy'(V, M, CP, Flag) :- var(V), !, '$do_spy'(call(V), M, CP, Flag).
'$do_spy'(!, _, CP, _) :- !, '$$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :- !, '$$cut_by'(M).
%'$do_spy'(V, M, CP, Flag) :-
% writeln('$do_spy'(V, M, CP, Flag)), fail.
'$do_spy'(V, M, CP, Flag) :-
var(V), !,
'$do_spy'(call(V), M, CP, Flag).
'$do_spy'(!, _, CP, _) :-
!, '$$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :-
!, '$$cut_by'(M).
'$do_spy'(true, _, _, _) :- !.
%'$do_spy'(fail, _, _, _) :- !, fail.
'$do_spy'(M:G, _, CP, CalledFromDebugger) :- !,
'$do_spy'(G, M, CP, CalledFromDebugger).
'$do_spy'((A,B), M, CP, CalledFromDebugger) :- !,
'$do_spy'(A, M, CP, yes),
'$do_spy'(A, M, CP, debugger),
'$do_spy'(B, M, CP, CalledFromDebugger).
'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes)
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger)
;
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes)
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger)
;
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((T->A), M, CP, _) :- !,
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) ).
'$do_spy'((T->A), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ).
'$do_spy'((A;B), M, CP, CalledFromDebugger) :- !,
(
'$do_spy'(A, M, CP, yes)
'$do_spy'(A, M, CP, CalledFromDebugger)
;
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !,
(
'$do_spy'(A, M, CP, yes)
'$do_spy'(A, M, CP, CalledFromDebugger)
;
'$do_spy'(B, M, CP, CalledFromDebugger)
).
@ -335,12 +351,12 @@ debugging :-
nb_setval('$spy_gn',L1), /* and save it globaly */
b_getval('$spy_glist',History), /* get goal list */
b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]), /* and update it */
'$loop_spy'(L, G, Module, CalledFromDebugger). /* set creep on */
'$loop_spy'(L, G, Module, CalledFromDebugger).
% we are skipping, so we can just call the goal,
% while leaving the minimal structure in place.
'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :-
yap_hacks:current_choice_point(CP),
'$current_choice_point'(CP),
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP),
Module, error(Event,Context),
'$loop_spy_event'(error(Event,Context), GoalNumber, G, Module, CalledFromDebugger)).
@ -360,7 +376,7 @@ debugging :-
throw(error('$fail_spy'(GoalNumber),[])).
'$loop_spy_event'(error('$done_spy'(G0),_), GoalNumber, G, _, CalledFromDebugger) :-
G0 >= GoalNumber, !,
'$continue_debugging'(CalledFromDebugger).
'$continue_debugging'(zip, CalledFromDebugger).
'$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !,
throw(error('$done_spy'(GoalNumber),[])).
'$loop_spy_event'(Event, GoalNumber, G, Module, CalledFromDebugger) :-
@ -380,8 +396,8 @@ debugging :-
% just fail here, don't really need to call debugger, the user knows what he
% wants to do
'$loop_fail'(_GoalNumber, _G, _Module, _CalledFromDebugger) :-
'$continue_debugging'(CalledFromDebugger),
'$loop_fail'(_GoalNumber, _G, _Module, CalledFromDebugger) :-
'$continue_debugging'(fail, CalledFromDebugger),
fail.
% if we are in
@ -400,16 +416,18 @@ debugging :-
/* call port */
'$enter_goal'(GoalNumber, G, Module),
'$spycall'(G, Module, CalledFromDebugger, Retry),
'$disable_docreep',
% make sure we are in system mode when running the debugger.
'$enter_system_mode',
(
'$debugger_deterministic_goal'(G) ->
Det=true
;
Det=false
),
/* go execute the predicate */
/* go execute the continuation */
(
Retry = false ->
/* exit port */
Retry = false,
/* found an answer, so it can redo */
nb_setarg(6, Info, true),
'$show_trace'(exit,G,Module,GoalNumber,Det), /* output message at exit */
@ -422,26 +440,28 @@ debugging :-
;
true
),
'$continue_debugging'(CalledFromDebugger)
;
'$continue_debugging'(exit, CalledFromDebugger)
;
% make sure we are in system mode when running the debugger.
'$enter_system_mode',
/* backtracking from exit */
/* we get here when we want to redo a goal */
/* redo port */
'$disable_docreep',
(
arg(6, Info, true)
arg(6, Info, true)
->
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
nb_setarg(6, Info, false)
;
true
),
'$continue_debugging'(CalledFromDebugger),
'$continue_debugging'(fail, CalledFromDebugger),
fail /* to backtrack to spycalls */
)
;
'$enter_system_mode',
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */
'$continue_debugging'(CalledFromDebugger),
'$continue_debugging'(fail, CalledFromDebugger),
/* fail port */
fail
).
@ -481,18 +501,26 @@ debugging :-
'$spycall'(G, M, _, _) :-
nb_getval('$debug_jump',true),
!,
'$exit_system_mode',
'$execute_nonstop'(G,M).
'$spycall'(G, M, _, _) :-
'$system_predicate'(G,M),
\+ '$is_metapredicate'(G,M), !,
'$execute'(M:G).
'$spycall'(G, M, _, _) :-
'$system_module'(M), !,
'$execute'(M:G).
(
'$system_predicate'(G,M)
;
'$system_module'(M)
),
!,
(
'$is_metapredicate'(G,M)
->
'$meta_creep'(G,M)
;
'$execute'(M:G)
).
'$spycall'(G, M, _, _) :-
'$tabled_predicate'(G,M),
!,
'$continue_debugging'(no, '$execute_nonstop'(G,M)).
'$continue_debugging_goal'(no, '$execute_nonstop'(G,M)).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$flags'(G,M,F,F),
F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source
@ -500,8 +528,7 @@ debugging :-
CP is '$last_choice_pt',
'$clause'(G, M, Cl, _),
% I may backtrack to here from far away
'$disable_docreep',
( '$do_spy'(Cl, M, CP, CalledFromDebugger) ; InRedo = true ).
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true ).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$undefined'(G, M), !,
'$find_goal_definition'(M, G, NM, Goal),
@ -511,17 +538,32 @@ debugging :-
CP is '$last_choice_pt',
'$static_clause'(G,M,_,R),
% I may backtrack to here from far away
'$disable_docreep',
(
'$continue_debugging'(no, '$execute_clause'(G, M, R, CP))
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
;
InRedo = true
).
'$meta_creep'(G,M) :-
(
'$$save_by'(CP1),
'$exit_system_mode',
'$meta_creep',
'$execute_nonstop'(G,M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', '$meta_creep', fail ) ),
'$enter_system_mode'
;
'$enter_system_mode',
fail
).
'$tabled_predicate'(G,M) :-
'$flags'(G,M,F,F),
F /\ 0x00000040 =\= 0.
%'$trace'(P,G,Module,L,Deterministic) :-
% '$nb_getval'('$system_mode',On,fail), writeln(On), fail.
'$trace'(P,G,Module,L,Deterministic) :-
% at this point we are done with leap or skip
nb_setval('$debug_run',off),
@ -584,8 +626,6 @@ debugging :-
'$action'(13,P,CallNumber,G,Module,Zip) :- !, % newline creep
get0(user_input,C),
'$action'(C,P,CallNumber,G,Module,Zip).
%'$action'(10,_,_,_,_,on) :- % newline creep
% nb_setval('$debug_jump',false).
'$action'(10,_,_,_,_,on) :- !, % newline creep
nb_setval('$debug_jump',false).
'$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute
@ -708,32 +748,50 @@ debugging :-
'$ilgl'(C),
fail.
'$continue_debugging'(yes).
% first argument is exit, zip or fail
% second is creep, meta_creep, spy, or debugger
%'$continue_debugging'(Exit, Debugger) :-
% writeln('$continue_debugging'(Exit, Debugger)), fail.
% that's what follows
'$continue_debugging'(_, debugger) :- !.
% do not need to debug!
'$continue_debugging'(no) :-
% go back to original sequence.
'$continue_debugging'(zip, _) :- !, '$exit_system_mode'.
'$continue_debugging'(fail, _) :- !.
'$continue_debugging'(exit, meta_creep) :- !,
'$exit_system_mode',
'$meta_creep'.
'$continue_debugging'(_, creep) :- !,
'$exit_system_mode',
'$creep'.
'$continue_debugging'(_, spy) :- !,
'$exit_system_mode',
'$creep'.
'$continue_debugging'(_, _) :- '$exit_system_mode'.
% if we are in the interpreter, don't need to care about forcing a trace, do we?
'$continue_debugging'(yes,G) :- !,
'$continue_debugging_goal'(yes,G) :- !,
'$execute_dgoal'(G).
% do not need to debug!
'$continue_debugging'(_,G) :-
'$continue_debugging_goal'(_,G) :-
'nb_getval'('$debug_run',Zip),
(Zip == nodebug ; number(Zip) ; Zip == spy ), !,
'$execute_dgoal'(G).
'$continue_debugging'(_,G) :-
'$continue_debugging_goal'(_,G) :-
'$execute_creep_dgoal'(G).
'$execute_dgoal'('$execute_nonstop'(G,M)) :-
'$execute_nonstop'(G,M).
'$exit_system_mode',
'$execute_nonstop'(G,M).
'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$execute_clause'(G, M, R, CP).
'$exit_system_mode',
'$execute_clause'(G, M, R, CP).
'$execute_creep_dgoal'('$execute_nonstop'(G,M)) :-
'$signal_creep',
'$creep',
'$execute_nonstop'(G,M).
'$execute_creep_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$signal_creep',
'$creep',
'$execute_clause'(G, M, R, CP).
'$show_ancestors'(HowMany) :-

8
pl/errors.yap
View File

@ -242,13 +242,13 @@ print_message(error, error(Msg,[Info|local_sp(P,CP,Envs,CPs)])) :- !,
erase(R).
print_message(Severity, Msg) :-
nonvar(Severity), nonvar(Msg),
'$notrace'(user:portray_message(Severity, Msg)), !.
user:portray_message(Severity, Msg), !.
% This predicate has more hooks than a pirate ship!
print_message(Severity, Term) :-
% first step at hook processing
'$message_to_lines'(Term, Lines),
( nonvar(Term),
'$once0'(message_hook(Term, Severity, Lines), user)
user:message_hook(Term, Severity, Lines)
->
true
;
@ -263,9 +263,9 @@ print_message(_, Term) :-
format(user_error,'~q~n',[Term]).
'$message_to_lines'(Term, Lines) :-
'$once0'(generate_message_hook(Term, [], Lines), user), !.
user:generate_message_hook(Term, [], Lines), !.
'$message_to_lines'(Term, Lines) :-
'$once0'(message(Term, Lines, []), prolog), !.
prolog:message(Term, Lines, []), !.
'$message_to_lines'(Term, Lines) :-
'$messages':generate_message(Term, Lines, []), !.

64
pl/flags.yap
View File

@ -328,27 +328,6 @@ yap_flag(version,X) :-
yap_flag(version,X) :-
'$do_error'(permission_error(modify,flag,version),yap_flag(version,X)).
yap_flag(version_data,X) :-
var(X), !,
'$get_version_codes'(Major,Minor,Patch),
X = yap(Major, Minor, Patch, 0).
yap_flag(version_data,X) :-
'$do_error'(permission_error(modify,flag,version),yap_flag(version_data,X)).
'$get_version_codes'(Major,Minor,Patch) :-
get_value('$version_name',X),
atom_codes(X,[_,_,_,_|VersionTag]), %'
'$fetch_num_code'(VersionTag,0,Major,L1),
'$fetch_num_code'(L1,0,Minor,L2),
'$fetch_num_code'(L2,0,Patch,_).
'$fetch_num_code'([],Code,Code,[]).
'$fetch_num_code'([C|Cs],Code0,CodeF,L) :-
C >= 0'0, C =< 0'9, !,
CodeI is Code0*10+(C-0'0), %'
'$fetch_num_code'(Cs,CodeI,CodeF,L).
'$fetch_num_code'([_|Cs],Code,Code,Cs).
yap_flag(max_integer,X) :-
var(X), !,
'$access_yap_flags'(0, 1),
@ -524,18 +503,14 @@ yap_flag(debug,X) :-
yap_flag(discontiguous_warnings,X) :-
var(X), !,
('$syntax_check_mode'(on,_), '$syntax_check_discontiguous'(on,_) ->
X = on
;
X = off
).
'$syntax_check_discontiguous'(on,_).
yap_flag(discontiguous_warnings,X) :-
'$transl_to_on_off'(_,X), !,
(X = on ->
'$syntax_check_mode'(_,on),
'$syntax_check_discontiguous'(_,on)
(X == on ->
style_check(discontiguous)
;
'$syntax_check_discontiguous'(_,off)).
style_check(-discontiguous)
).
yap_flag(discontiguous_warnings,X) :-
'$do_error'(domain_error(flag_value,discontiguous_warnings+X),yap_flag(discontiguous_warnings,X)).
@ -548,18 +523,14 @@ yap_flag(occurs_check,X) :-
yap_flag(redefine_warnings,X) :-
var(X), !,
('$syntax_check_mode'(on,_), '$syntax_check_multiple'(on,_) ->
X = on
;
X = off
).
'$syntax_check_multiple'(X,X).
yap_flag(redefine_warnings,X) :-
'$transl_to_on_off'(_,X), !,
(X = on ->
'$syntax_check_mode'(_,on),
'$syntax_check_multiple'(_,on)
(X == on ->
style_check(multiple)
;
'$syntax_check_multiple'(_,off)).
style_check(-multiple)
).
yap_flag(redefine_warnings,X) :-
'$do_error'(domain_error(flag_value,redefine_warnings+X),yap_flag(redefine_warnings,X)).
@ -580,18 +551,14 @@ yap_flag(open_expands_filename,Expand) :-
yap_flag(single_var_warnings,X) :-
var(X), !,
('$syntax_check_mode'(on,_), '$syntax_check_single_var'(on,_) ->
X = on
;
X = off
).
'$syntax_check_single_var'(X,X).
yap_flag(single_var_warnings,X) :-
'$transl_to_on_off'(_,X), !,
(X = on ->
'$syntax_check_mode'(_,on),
'$syntax_check_single_var'(_,on)
(X == on ->
style_check(single_var)
;
'$syntax_check_single_var'(_,off)).
style_check(-single_var)
).
yap_flag(single_var_warnings,X) :-
'$do_error'(domain_error(flag_value,single_var_warnings+X),yap_flag(single_var_warnings,X)).
@ -911,7 +878,6 @@ yap_flag(dialect,yap).
'$yap_system_flag'(verbose_load).
'$yap_system_flag'(verbose_auto_load).
'$yap_system_flag'(version).
'$yap_system_flag'(version_data).
'$yap_system_flag'(windows).
'$yap_system_flag'(write_strings).

3
pl/hacks.yap
View File

@ -47,7 +47,7 @@ code_location(Info,Where,Location) :-
integer(Where) , !,
'$pred_for_code'(Where,Name,Arity,Mod,Clause),
construct_code(Clause,Name,Arity,Mod,Info,Location).
code_location(Info,_,Info).
code_location(Ixnfo,_,Info).
construct_code(-1,Name,Arity,Mod,Where,Location) :- !,
number_codes(Arity,ArityCode),
@ -126,6 +126,7 @@ show_cp(CP, Continuation) -->
show_env(Env,Cont,NCont) -->
{
yap_hacks:continuation(Env, Addr, NCont, _),
format('0x~16r 0x~16r~n',[Env,NCont]),
yap_hacks:cp_to_predicate(Cont, Mod, Name, Arity, ClId)
},
[ '0x~16r~t ~16+ ~d~16+ ~q:' -

14
pl/init.yap
View File

@ -140,8 +140,8 @@ system_mode(verbose,off) :- set_value('$verbose',off).
:- use_module('history.pl').
:- use_module('dbload.yap').
:- use_module('swi.yap').
:- use_module('../LGPL/predopts.pl').
:- use_module('../LGPL/menu.pl').
:- use_module('../swi/library/predopts.pl').
:- use_module('../swi/library/menu.pl').
'$system_module'('$attributes').
@ -177,7 +177,7 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- set_value('$user_module',user), '$protect'.
:- style_check([]).
:- style_check([-discontiguous,-multiple,-single_var]).
%
% moved this to init_gc in gc.c to separate the alpha
@ -270,6 +270,14 @@ file_search_path(yap, Home) :-
file_search_path(system, Dir) :-
prolog_flag(host_type, Dir).
file_search_path(foreign, yap('lib/Yap')).
file_search_path(path, C) :-
( getenv('PATH', A),
( current_prolog_flag(windows, true)
-> atomic_list_concat(B, ;, A)
; atomic_list_concat(B, :, A)
),
lists:member(C, B)
).
:- yap_flag(unknown,error).

10
pl/messages.yap
View File

@ -37,6 +37,8 @@ file_position(FileName,LN,MsgCodes) -->
generate_message(halt) --> !,
['YAP execution halted'].
generate_message(false) --> !,
['false.'].
generate_message('$abort') --> !,
['YAP execution aborted'].
generate_message(abort(user)) --> !,
@ -165,6 +167,9 @@ system_message(error(context_error(Goal,Who),Where)) -->
system_message(error(domain_error(DomainType,Opt), Where)) -->
[ 'DOMAIN ERROR- ~w: ' - Where],
domain_error(DomainType, Opt).
system_message(error(format_argument_type(Type,Arg), Where)) -->
[ 'FORMAT ARGUMENT ERROR- ~~~a called with ~w in ~w: ' - [Type,Arg,Where]],
domain_error(DomainType, Opt).
system_message(error(existence_error(directory,Key), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an existing directory' - [Where,Key] ].
system_message(error(existence_error(key,Key), Where)) -->
@ -423,8 +428,9 @@ object_name(unsigned_byte, 'unsigned byte').
object_name(unsigned_char, 'unsigned char').
object_name(variable, 'unbound variable').
svs([H]) --> !, H.
svs([H|L]) -->
svs([A]) --> !, { atom_codes(A, H) }, H.
svs([A|L]) -->
{ atom_codes(A, H) },
H,
", ",
svs(L).

4
pl/modules.yap
View File

@ -396,7 +396,7 @@ expand_goal(G, G).
% make built-in processing transparent.
'$match_mod'(G, M, ORIG, HM, G1),
'$c_built_in'(G1, M, Gi),
G1 = G2.
Gi = G2.
'$complete_goal_expansion'(G, GMod, _, HM, NG, NG, _) :-
'$match_mod'(G, GMod, GMod, HM, NG).
@ -535,7 +535,7 @@ expand_goal(G, G).
% expand argument
'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !.
'$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :-
arg(I,D,X), (X==':' ; integer(X)),
arg(I,D,X), (X==':' -> true ; integer(X)),
arg(I,G,A), '$do_expand'(A,HVars),
!,
arg(I,NG,M:A),

3
pl/qly.yap
View File

@ -141,7 +141,8 @@ save_program(File, _Goal) :-
X \= user_input,
X \= user_output,
X \= user_error,
X \= version.
X \= version,
X \= version_data.
'$init_state' :-
recorded('$program_state', _, _), !,

8
pl/setof.yap
View File

@ -50,10 +50,12 @@ findall(Template, Generator, Answers, SoFar) :-
nb:nb_queue(Ref),
(
'$execute'(Generator),
'$stop_creeping',
nb:nb_queue_enqueue(Ref, Template),
fail
fail
;
nb:nb_queue_close(Ref, Answers, SoFar)
'$stop_creeping',
nb:nb_queue_close(Ref, Answers, SoFar)
).
@ -147,9 +149,11 @@ all(T,G,S) :-
'$init_db_queue'(Ref),
( '$catch'(Error,'$clean_findall'(Ref,Error),_),
'$execute'(G),
'$stop_creeping',
'$db_enqueue'(Ref, T),
fail
;
'$stop_creeping',
'$$set'(S,Ref)
).

134
pl/signals.yap
View File

@ -33,39 +33,10 @@
'$wake_up_goal'(G, LG).
% never creep on entering system mode!!!
% don't creep on meta-call.
'$do_signal'(sig_creep, [M|G]) :-
'$creep_allowed', !,
(
( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 )
->
(
'$execute_nonstop'(G0,M),
'$signal_creep'
;
'$signal_creep',
fail
)
;
'$start_creep'([M|G])
).
%
'$do_signal'(sig_creep, [M|G]) :-
( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ),
!,
(
'$execute_nonstop'(G0,M),
'$signal_creep'
;
'$signal_creep',
fail
).
%
'$do_signal'(sig_creep, [M|G]) :-
'$signal_creep',
'$execute_nonstop'(G,M).
'$do_signal'(sig_delay_creep, [M|G]) :-
'$execute'(M:G),
'$creep'.
'$do_signal'(sig_creep, MG) :-
'$start_creep'(MG, creep).
'$do_signal'(sig_delay_creep, MG) :-
'$start_creep'(MG, meta_creep).
'$do_signal'(sig_iti, [M|G]) :-
'$thread_gfetch'(Goal),
% if more signals alive, set creep flag
@ -117,96 +88,15 @@
'$current_module'(M0),
'$execute0'((Goal,M:G),M0).
% '$execute0' should be ignored.
'$start_creep'([_|'$execute0'(G,M)]) :-
!,
'$start_creep'([M|G]).
% '$call'() is a complicated thing
'$start_creep'([M0|'$call'(G, CP, G0, M)]) :-
!,
'$creep',
'$execute_nonstop'('$call'(G, CP, G0, M),M0).
% donotrace: means do not trace! So,
% ignore and then put creep back for the continuation.
'$start_creep'([M0|'$notrace'(G)]) :-
!,
(
CP0 is '$last_choice_pt',
'$execute_nonstop'(G,M0),
CP1 is '$last_choice_pt',
% exit port: creep
'$creep',
(
% if deterministic just creep all you want.
CP0 = CP1 ->
!
;
% extra disjunction protects reentry into usergoal
(
% cannot cut here
true
;
% be sure to disable creep on redo port
'$disable_creep',
fail
)
)
;
% put it back again on fail
'$creep',
fail
).
'$start_creep'([M0|'$oncenotrace'(G)]) :-
!,
('$execute_nonstop'(G,M0),
CP1 is '$last_choice_pt',
% exit port: creep
'$creep',
!
;
% put it back again on fail
'$creep',
fail
).
'$start_creep'([M0|'$once0'(G)]) :-
!,
('$execute_nonstop'(G,M0),
CP1 is '$last_choice_pt',
% exit port: creep
'$creep',
!
;
% put it back again on fail
'$creep',
fail
).
% do not debug if we are not in debug mode.
'$start_creep'([Mod|G]) :-
'$debug_on'(DBON), DBON = false, !,
'$execute_nonstop'(G,Mod).
'$start_creep'([Mod|G]) :-
nb_getval('$system_mode',on), !,
'$execute_nonstop'(G,Mod).
% notice that the last signal to be processed must always be creep
'$start_creep'([_|'$cut_by'(CP)]) :- !,
'$$cut_by'(CP),
'$creep'.
'$start_creep'([_|true]) :- !,
'$creep'.
'$start_creep'([Mod|G]) :-
'$hidden_predicate'(G,Mod), !,
'$execute_nonstop'(G,Mod),
'$creep'.
% do not debug if we are zipping through.
'$start_creep'([Mod|G]) :-
nb_getval('$debug_run',Run),
Run \= off,
'$zip'(-1, G, Mod), !,
'$signal_creep',
'$execute_goal'(G, Mod).
'$start_creep'([Mod|G]) :-
% we may be creeping outside and coming back to system mode.
'$start_creep'([_|'$enter_system_mode'], _) :- !,
'$enter_system_mode'.
'$start_creep'([Mod|G], _) :-
'$in_system_mode', !,
'$execute0'(G, Mod).
'$start_creep'([Mod|G], WhereFrom) :-
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, no).
'$do_spy'(G, Mod, CP, WhereFrom).
'$execute_goal'(G, Mod) :-
(

11
pl/utils.yap
View File

@ -449,6 +449,17 @@ atomic_concat(X,Y,At) :-
name(X, Xs),
name(Y, Ys).
%
% small compatibility hack
%
sub_string(String, Bef, Size, After, SubStr) :-
catch(string_to_atom(String, A), _, true),
catch(string_to_atom(SubStr, SubA), _, true),
sub_atom(A, Bef, Size, After, SubA),
catch(string_to_atom(String, A), _, true),
catch(string_to_atom(SubStr, SubA), _, true).
sub_atom(At, Bef, Size, After, SubAt) :-
% extract something from an atom
atom(At), integer(Bef), integer(Size), !,

0
LGPL/swi_console/Makefile.in → swi/console/Makefile.in
View File

0
LGPL/swi_console/README → swi/console/README
View File

0
LGPL/clp/Makefile.in → swi/console/clp/Makefile.in
View File

0
LGPL/clp/clp_events.pl → swi/console/clp/clp_events.pl
View File

0
LGPL/swi_console/common.h → swi/console/common.h
View File

0
LGPL/swi_console/complete.c → swi/console/complete.c
View File

Some files were not shown because too many files have changed in this diff Show More