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

Merge branch 'master' of ../yap-6.2

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-12-19 22:07:44 +00:00
commit 8cee9a27c7
64 changed files with 1497 additions and 1333 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
C/absmi.c
View File

@ -2702,7 +2702,9 @@ Yap_absmi(int inp)
/*
don't do a creep here; also, if our instruction is followed by
a execute_c, just wait a bit more */
if (ActiveSignals & YAP_CREEP_SIGNAL ||
if ( (ActiveSignals & YAP_CREEP_SIGNAL &&
/* keep on going if there is something else */
!(ActiveSignals & ~YAP_CREEP_SIGNAL)) ||
(PREG->opc != Yap_opcode(_procceed) &&
PREG->opc != Yap_opcode(_cut_e))) {
GONext();
@ -4261,17 +4263,17 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(get_bigint, xc);
Op(get_bigint, xN);
#ifdef USE_GMP
BEGD(d0);
d0 = XREG(PREG->u.xc.x);
d0 = XREG(PREG->u.xN.x);
deref_head(d0, gbigint_unk);
gbigint_nonvar:
if (!IsApplTerm(d0))
FAIL();
/* we have met a preexisting bigint */
START_PREFETCH(xc);
START_PREFETCH(xN);
BEGP(pt0);
pt0 = RepAppl(d0);
/* check functor */
@ -4279,9 +4281,9 @@ Yap_absmi(int inp)
{
FAIL();
}
if (Yap_gmp_tcmp_big_big(d0,PREG->u.xc.c))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.xN.b))
FAIL();
PREG = NEXTOP(PREG, xc);
PREG = NEXTOP(PREG, xN);
ENDP(pt0);
/* enter read mode */
GONext();
@ -4291,10 +4293,10 @@ Yap_absmi(int inp)
deref_body(d0, pt0, gbigint_unk, gbigint_nonvar);
/* Enter Write mode */
/* set d1 to be the new structure we are going to create */
START_PREFETCH(xc);
START_PREFETCH(xN);
BEGD(d1);
d1 = PREG->u.xc.c;
PREG = NEXTOP(PREG, xc);
d1 = PREG->u.xN.b;
PREG = NEXTOP(PREG, xN);
BIND(pt0, d1, bind_gbigint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -4313,16 +4315,16 @@ Yap_absmi(int inp)
ENDOp();
Op(get_dbterm, xc);
Op(get_dbterm, xD);
BEGD(d0);
d0 = XREG(PREG->u.xc.x);
d0 = XREG(PREG->u.xD.x);
deref_head(d0, gdbterm_unk);
gdbterm_nonvar:
BEGD(d1);
/* we have met a preexisting dbterm */
d1 = PREG->u.xc.c;
PREG = NEXTOP(PREG, xc);
d1 = PREG->u.xD.D;
PREG = NEXTOP(PREG, xD);
UnifyBound(d0,d1);
ENDD(d1);
@ -4330,10 +4332,10 @@ Yap_absmi(int inp)
deref_body(d0, pt0, gdbterm_unk, gdbterm_nonvar);
/* Enter Write mode */
/* set d1 to be the new structure we are going to create */
START_PREFETCH(xc);
START_PREFETCH(xD);
BEGD(d1);
d1 = PREG->u.xc.c;
PREG = NEXTOP(PREG, xc);
d1 = PREG->u.xD.D;
PREG = NEXTOP(PREG, xD);
BIND(pt0, d1, bind_gdbterm);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -6347,7 +6349,7 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(unify_bigint, oc);
Op(unify_bigint, oN);
#ifdef USE_GMP
BEGD(d0);
BEGP(pt0);
@ -6368,16 +6370,16 @@ Yap_absmi(int inp)
FAIL();
}
ENDD(d1);
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oc.c))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oN.b))
FAIL();
PREG = NEXTOP(PREG, oc);
PREG = NEXTOP(PREG, oN);
ENDP(pt0);
GONext();
derefa_body(d0, pt0, ubigint_unk, ubigint_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oN.b;
PREG = NEXTOP(PREG, oN);
BIND_GLOBAL(pt0, d1, bind_ubigint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -6393,7 +6395,7 @@ Yap_absmi(int inp)
#endif
ENDOp();
Op(unify_l_bigint, oc);
Op(unify_l_bigint, oN);
#ifdef USE_GMP
BEGD(d0);
CACHE_S();
@ -6413,16 +6415,16 @@ Yap_absmi(int inp)
FAIL();
}
ENDD(d0);
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oc.c))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oN.b))
FAIL();
PREG = NEXTOP(PREG, oc);
PREG = NEXTOP(PREG, oN);
ENDP(pt0);
GONext();
derefa_body(d0, S_SREG, ulbigint_unk, ulbigint_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oN.b;
PREG = NEXTOP(PREG, oN);
BIND_GLOBAL(S_SREG, d1, bind_ulbigint);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
@ -6438,7 +6440,7 @@ Yap_absmi(int inp)
#endif
ENDOp();
Op(unify_dbterm, oc);
Op(unify_dbterm, oD);
BEGD(d0);
BEGP(pt0);
pt0 = SREG++;
@ -6447,15 +6449,15 @@ Yap_absmi(int inp)
udbterm_nonvar:
BEGD(d1);
/* we have met a preexisting dbterm */
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
UnifyBound(d0,d1);
ENDD(d1);
derefa_body(d0, pt0, udbterm_unk, udbterm_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
BIND_GLOBAL(pt0, d1, bind_udbterm);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -6468,7 +6470,7 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(unify_l_dbterm, oc);
Op(unify_l_dbterm, oD);
BEGD(d0);
CACHE_S();
READ_IN_S();
@ -6477,15 +6479,15 @@ Yap_absmi(int inp)
uldbterm_nonvar:
BEGD(d1);
/* we have met a preexisting dbterm */
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
UnifyBound(d0,d1);
ENDD(d1);
derefa_body(d0, S_SREG, uldbterm_unk, uldbterm_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
BIND_GLOBAL(S_SREG, d1, bind_uldbterm);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
@ -6907,8 +6909,26 @@ Yap_absmi(int inp)
GONext();
ENDD(d0);
ENDOp();
Op(put_dbterm, xD);
BEGD(d0);
d0 = PREG->u.xD.D;
XREG(PREG->u.xD.x) = d0;
PREG = NEXTOP(PREG, xD);
GONext();
ENDD(d0);
ENDOp();
Op(put_float, xd);
Op(put_bigint, xN);
BEGD(d0);
d0 = PREG->u.xN.b;
XREG(PREG->u.xN.x) = d0;
PREG = NEXTOP(PREG, xN);
GONext();
ENDD(d0);
ENDOp();
Op(put_float, xd);
BEGD(d0);
d0 = AbsAppl(PREG->u.xd.d);
XREG(PREG->u.xd.x) = d0;
@ -7101,6 +7121,24 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(write_bigint, N);
BEGD(d0);
d0 = PREG->u.N.b;
*SREG++ = d0;
ENDD(d0);
PREG = NEXTOP(PREG, N);
GONext();
ENDOp();
Op(write_dbterm, D);
BEGD(d0);
d0 = PREG->u.D.D;
*SREG++ = d0;
ENDD(d0);
PREG = NEXTOP(PREG, D);
GONext();
ENDOp();
Op(write_float, d);
BEGD(d0);
d0 = AbsAppl(PREG->u.d.d);

16
C/agc.c
View File

@ -114,20 +114,6 @@ AtomAdjust(Atom a)
static Term AdjustDBTerm(Term, Term *);
static Term
CodeComposedTermAdjust(Term t)
{
Term *base;
if (IsApplTerm(t)) {
base = RepAppl(t);
} else {
base = RepPair(t);
}
return AdjustDBTerm(t, base);
}
#define IsOldCode(P) FALSE
#define IsOldCodeCellPtr(P) FALSE
#define IsOldDelay(P) FALSE
@ -161,7 +147,7 @@ CodeComposedTermAdjust(Term t)
#define ModEntryPtrAdjust(P) (P)
#define AtomEntryAdjust(P) (P)
#define GlobalEntryAdjust(P) (P)
#define BlobTermAdjust(P) (P)
#define BlobTermInCodeAdjust(P) (P)
#define CellPtoHeapAdjust(P) (P)
#define PtoAtomHashEntryAdjust(P) (P)
#define CellPtoHeapCellAdjust(P) (P)

84
C/amasm.c
View File

@ -1083,15 +1083,15 @@ a_uc(CELL rnd1, op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_
}
inline static yamop *
a_blob(CELL rnd1, op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
a_wblob(CELL rnd1, op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.c.c =
code_p->u.N.b =
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(c);
GONEXT(N);
return code_p;
}
@ -1117,11 +1117,11 @@ a_wdbt(CELL rnd1, op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.c.c = rnd1;
code_p->u.D.D = rnd1;
add_to_dbtermsl(cip, cip->cpc->rnd1);
}
*clause_has_dbtermp = TRUE;
GONEXT(c);
GONEXT(D);
return code_p;
}
@ -1130,13 +1130,13 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.oc.opcw = emit_op(opcode_w);
code_p->u.oc.c =
code_p->u.oN.opcw = emit_op(opcode_w);
code_p->u.oN.b =
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(oc);
GONEXT(oN);
return code_p;
}
@ -1145,12 +1145,12 @@ a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbterm
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.oc.opcw = emit_op(opcode_w);
code_p->u.oc.c = cip->cpc->rnd1;
code_p->u.oD.opcw = emit_op(opcode_w);
code_p->u.oD.D = cip->cpc->rnd1;
add_to_dbtermsl(cip, cip->cpc->rnd1);
}
*clause_has_dbtermp = TRUE;
GONEXT(oc);
GONEXT(oD);
return code_p;
}
@ -1372,11 +1372,11 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xc.x = emit_x(cip->cpc->rnd2);
code_p->u.xc.c = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
code_p->u.xN.x = emit_x(cip->cpc->rnd2);
code_p->u.xN.b = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(xc);
GONEXT(xN);
return code_p;
}
@ -1385,12 +1385,12 @@ a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, st
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xc.x = emit_x(cip->cpc->rnd2);
code_p->u.xc.c = cip->cpc->rnd1;
code_p->u.xD.x = emit_x(cip->cpc->rnd2);
code_p->u.xD.D = cip->cpc->rnd1;
add_to_dbtermsl(cip, cip->cpc->rnd1);
}
*clause_has_dbtermp = TRUE;
GONEXT(xc);
GONEXT(xD);
return code_p;
}
@ -1480,7 +1480,7 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
op = _p_equal; /* just to make some compilers happy */
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "internal assembler error for built-in (%d)", (Flags & 0x7f));
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
}
if (is_test) {
UInt lab;
@ -1503,7 +1503,7 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil,
"user defined predicate cannot be a test predicate");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
} else
code_p->opc = emit_op(_call_c_wfail);
code_p->u.slp.s =
@ -2053,7 +2053,7 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
/* OOOPS, got in trouble, must do a longjmp and recover space */
save_machine_regs();
_longjmp(cip->CompilerBotch,2);
siglongjmp(cip->CompilerBotch,2);
}
Yap_LUIndexSpace_CP += size;
#ifdef DEBUG
@ -2693,7 +2693,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _plus:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for +/2 (should be XC)");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _minus:
code_p->opc = emit_op(_p_minus_y_cv);
@ -2701,7 +2701,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _times:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for */2 (should be XC)");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _div:
code_p->opc = emit_op(_p_div_y_cv);
@ -2709,12 +2709,12 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _and:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for /\\/2 (should be XC)");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _or:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for \\//2 (should be XC)");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _sll:
code_p->opc = emit_op(_p_sll_y_cv);
@ -2744,7 +2744,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _minus:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x2_arg, "internal assembler error XC for -/2");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _times:
code_p->opc = emit_op(_p_times_y_vc);
@ -2777,7 +2777,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _arg:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x2_arg, "internal assembler error for arg/3");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _functor:
code_p->opc = emit_op(_p_func2s_y_vc);
@ -2838,7 +2838,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _plus:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for +/2");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _minus:
code_p->opc = emit_op(_p_minus_cv);
@ -2846,7 +2846,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _times:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for */2");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _div:
code_p->opc = emit_op(_p_div_cv);
@ -2854,12 +2854,12 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _and:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for /\\/2");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _or:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x1_arg, "internal assembler error CX for \\//2");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _sll:
code_p->opc = emit_op(_p_sll_cv);
@ -2889,7 +2889,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _minus:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x2_arg, "internal assembler error XC for -/2");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _times:
code_p->opc = emit_op(_p_times_vc);
@ -2922,7 +2922,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
case _arg:
Yap_Error(INTERNAL_COMPILER_ERROR, cmp_info->x2_arg, "internal assembler error for arg/3");
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
break;
case _functor:
code_p->opc = emit_op(_p_func2s_vc);
@ -3248,10 +3248,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_ri(_put_longint, code_p, pass_no, cip->cpc);
break;
case put_bigint_op:
code_p = a_rb(_put_atom, clause_has_blobsp, code_p, pass_no, cip);
code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case put_dbterm_op:
code_p = a_dbt(_put_atom, clause_has_dbtermp, code_p, pass_no, cip);
code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
case get_list_op:
code_p = a_glist(&do_not_optimise_uatom, code_p, pass_no, cip);
@ -3344,10 +3344,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_wi(_write_longint, code_p, pass_no, cip->cpc);
break;
case write_bigint_op:
code_p = a_blob(cip->cpc->rnd1, _write_atom, clause_has_blobsp, code_p, pass_no, cip);
code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case write_dbterm_op:
code_p = a_wdbt(cip->cpc->rnd1, _write_atom, clause_has_dbtermp, code_p, pass_no, cip);
code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
case unify_list_op:
code_p = a_ue(_unify_list, _unify_list_write, code_p, pass_no);
@ -3540,7 +3540,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
if (CellPtr(cip->label_offset+cip->cpc->rnd1) > ASP-256) {
Yap_Error_Size = 256+((char *)(cip->label_offset+cip->cpc->rnd1) - (char *)H);
save_machine_regs();
_longjmp(cip->CompilerBotch, 3);
siglongjmp(cip->CompilerBotch, 3);
}
if ( (char *)(cip->label_offset+cip->cpc->rnd1) >= cip->freep)
cip->freep = (char *)(cip->label_offset+(cip->cpc->rnd1+1));
@ -3722,7 +3722,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
if (cip->cpc->nextInst->op != bccall_op) {
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "compiling binary test", (int) cip->cpc->op);
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
}
code_p = a_bfunc(cip->cpc->nextInst->rnd2, &clinfo, code_p, pass_no, cip);
break;
@ -3762,7 +3762,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
default:
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "instruction %d found while assembling", (int) cip->cpc->op);
save_machine_regs();
_longjmp(cip->CompilerBotch, 1);
siglongjmp(cip->CompilerBotch, 1);
}
cip->cpc = cip->cpc->nextInst;
}
@ -3788,7 +3788,7 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep)
case OUT_OF_STACK_ERROR:
Yap_Error_Size = 256+((char *)cip->freep - (char *)H);
save_machine_regs();
_longjmp(cip->CompilerBotch,3);
siglongjmp(cip->CompilerBotch,3);
case OUT_OF_TRAIL_ERROR:
/* don't just return NULL */
ARG1 = *tp;
@ -3865,7 +3865,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
Yap_LabelFirstArraySz = DEFAULT_NLABELS;
if (!Yap_LabelFirstArray) {
save_machine_regs();
_longjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
}
}
if (Yap_LabelFirstArray && max_label <= Yap_LabelFirstArraySz) {
@ -3874,7 +3874,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
cip->label_offset = (Int *)Yap_AllocCodeSpace(sizeof(Int)*max_label);
if (!cip->label_offset) {
save_machine_regs();
_longjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
}
}
}

16
C/cdmgr.c
View File

@ -771,8 +771,10 @@ get_pred(Term t, Term tmod, char *pname)
#define ModuleAdjust(X) (X)
#define ExternalFunctionAdjust(X) (X)
#define AdjustSwitchTable(X,Y,Z)
#define DBGroundTermAdjust(X) (X)
#define rehash(A,B,C)
static Term BlobTermAdjust(Term t)
static Term BlobTermInCodeAdjust(Term t)
{
#if TAGS_FAST_OPS
return t-ClDiff;
@ -781,22 +783,12 @@ static Term BlobTermAdjust(Term t)
#endif
}
static Term ConstantTermAdjust (Term);
static Term
ConstantTermAdjust (Term t)
{
if (IsAtomTerm(t))
return AtomTermAdjust(t);
else if (IsIntTerm(t))
return t;
else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
return BlobTermAdjust(t);
} else if (IsApplTerm(t) || IsPairTerm(t)) {
return CodeComposedTermAdjust(t);
} else {
return t;
}
return t;
}

92
C/compiler.c
View File

@ -533,7 +533,7 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
if (H >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
p->NextCE = cglobs->common_exps;
cglobs->common_exps = p;
@ -568,7 +568,7 @@ compile_sf_term(Term t, int argno, int level)
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "illegal argument of soft functor";
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
}
else
c_var(t, -argno, arity, level, cglobs);
@ -595,7 +595,7 @@ c_args(Term app, unsigned int level, compiler_struct *cglobs)
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "exceed maximum arity of compiled goal";
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
}
if (Arity > cglobs->max_args)
cglobs->max_args = Arity;
@ -615,7 +615,7 @@ try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_s
/* oops, too deep a term */
save_machine_regs();
Yap_Error_Size = 0;
_longjmp(cglobs->cint.CompilerBotch, OUT_OF_AUX_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_AUX_BOTCH);
}
if (g < 16)
return FALSE;
@ -626,18 +626,18 @@ try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_s
switch(Yap_Error_TYPE) {
case OUT_OF_STACK_ERROR:
Yap_Error_TYPE = YAP_NO_ERROR;
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_STACK_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_STACK_BOTCH);
case OUT_OF_TRAIL_ERROR:
Yap_Error_TYPE = YAP_NO_ERROR;
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TRAIL_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TRAIL_BOTCH);
case OUT_OF_HEAP_ERROR:
Yap_Error_TYPE = YAP_NO_ERROR;
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_HEAP_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_HEAP_BOTCH);
case OUT_OF_AUXSPACE_ERROR:
Yap_Error_TYPE = YAP_NO_ERROR;
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_AUX_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_AUX_BOTCH);
default:
_longjmp(cglobs->cint.CompilerBotch,COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,COMPILER_ERR_BOTCH);
}
}
H = h0;
@ -1004,7 +1004,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2 with output bound", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
}
} else { /* t1 is bound */
@ -1019,7 +1019,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/3",s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
} else {
if (Op == _functor) {
@ -1035,7 +1035,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling functor/3");
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
i2 = IntegerOfTerm(t2);
if (i2 < 0) {
@ -1047,7 +1047,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling functor/3");
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
if (IsNumTerm(t1)) {
/* we will always fail */
@ -1062,7 +1062,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling functor/3");
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
if (i2 == 0)
c_eq(t1, t3, cglobs);
@ -1074,7 +1074,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
if (H+2 >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
RESET_VARIABLE(H);
RESET_VARIABLE(H+1);
@ -1086,7 +1086,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
if (H >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
RESET_VARIABLE(H);
H++;
@ -1098,7 +1098,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Prop p0 = PredPropByFunc(f, mod);
if (EndOfPAEntr(p0)) {
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
}
c_args(Goal, 0, cglobs);
Yap_emit(safe_call_op, (CELL)p0 , Zero, &cglobs->cint);
@ -1120,7 +1120,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
if (IsAtomicTerm(t2) ||
(IsApplTerm(t2) && IsExtensionFunctor(FunctorOfTerm(t2)))) {
@ -1132,7 +1132,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
} else if (IsApplTerm(t2)) {
Functor f = FunctorOfTerm(t2);
if (i1 < 1 || i1 > ArityOfFunctor(f)) {
@ -1163,7 +1163,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
}
if (Op == _functor) {
@ -1176,7 +1176,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
} else {
if (!IsVarTerm(t2)) {
Int arity;
@ -1191,7 +1191,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
arity = IntOfTerm(t2);
if (arity < 0) {
@ -1209,12 +1209,12 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
if (H+1+arity >= (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
tnew = AbsAppl(H);
*H++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),arity);
@ -1253,7 +1253,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2 with output bound", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
}
/* then we compile the opcode/result */
@ -1263,7 +1263,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
c_var(tmpvar,f_flag,(unsigned int)Op, 0, cglobs);
c_eq(tmpvar,t3, cglobs);
@ -1276,7 +1276,7 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler
Yap_bip_name(Op, s);
sprintf(Yap_ErrorMessage, "compiling %s/2 with input unbound", s);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
} else if (IsNewVar(t3) && cglobs->curbranch == 0 && cglobs->cint.CurrentPred->PredFlags & TabledPredFlag) {
Term nv = MkVarTerm();
@ -1342,7 +1342,7 @@ c_functor(Term Goal, Term mod, compiler_struct *cglobs)
if (EndOfPAEntr(p0)) {
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
}
if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint);
@ -1443,7 +1443,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
Yap_Error_Term = M;
Yap_ErrorMessage = "in module name";
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
}
Goal = ArgOfTerm(2, Goal);
mod = M;
@ -1561,7 +1561,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
p = RepPredProp(p0 = Yap_PredPropByAtomNonThreadLocal(atom, mod));
if (EndOfPAEntr(p0)) {
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
}
/* if we are profiling, make sure we register we entered this predicate */
if (profiling)
@ -1574,7 +1574,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
p = RepPredProp(p0 = Yap_PredPropByFunctorNonThreadLocal(f, mod));
if (EndOfPAEntr(p0)) {
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
}
if (f == FunctorOr || f == FunctorVBar) {
Term arg;
@ -1649,7 +1649,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
savecpc = cglobs->cint.cpc;
savencpc = FirstP->nextInst;
@ -1732,7 +1732,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
push_branch(cglobs->onbranch, commitvar, cglobs);
++cglobs->curbranch;
@ -1767,7 +1767,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
cglobs->onlast = FALSE;
c_var(commitvar, save_b_flag, 1, 0, cglobs);
@ -1882,7 +1882,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
Yap_ErrorMessage = Yap_ErrorSay;
sprintf(Yap_ErrorMessage, "compiling %s/2 with second arg unbound", RepAtom(NameOfFunctor(p->FunctorOfPred))->StrOfAE);
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,1);
siglongjmp(cglobs->cint.CompilerBotch,1);
}
c_var(a1, bt1_flag, 2, 0, cglobs);
cglobs->current_p0 = p0;
@ -1893,7 +1893,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
c_eq(t2, a2, cglobs);
c_var(a1, bt1_flag, 2, 0, cglobs);
@ -1906,7 +1906,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
c_eq(t1, a1, cglobs);
@ -1920,7 +1920,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
if (H == (CELL *)cglobs->cint.freep0) {
/* oops, too many new variables */
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
}
c_eq(t2, a2, cglobs);
c_var(t1, bt1_flag, 2, 0, cglobs);
@ -2287,7 +2287,7 @@ clear_bvarray(int var, CELL *bvarray
Yap_ErrorMessage = "compiler internal error: variable initialised twice";
fprintf(stderr," vsc: compiling7\n");
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
}
cglobs->pbvars++;
#endif
@ -2328,7 +2328,7 @@ push_bvmap(int label, PInstr *pcpc, compiler_struct *cglobs)
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "Too many embedded disjunctions";
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
}
/* the label instruction */
bvstack[bvindex].lab = label;
@ -2351,7 +2351,7 @@ reset_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs)
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "No embedding in disjunctions";
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
}
env_size = (bvstack[bvindex-1].pc)->rnd1;
size = env_size/(8*sizeof(CELL));
@ -2371,7 +2371,7 @@ pop_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs)
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "Too few embedded disjunctions";
/* save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); */
siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); */
}
reset_bvmap(bvarray, nperm, cglobs);
bvindex--;
@ -2641,7 +2641,7 @@ checktemp(Int arg, Int rn, compiler_vm_op ic, compiler_struct *cglobs)
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "too many temporaries";
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
}
v->NoOfVE = cglobs->vadr = vadr = TempVar | target1;
v->KindOfVE = TempVar;
@ -2774,7 +2774,7 @@ c_layout(compiler_struct *cglobs)
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "wrong number of variables found in bitmap";
save_machine_regs();
_longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
}
#endif
}
@ -3319,7 +3319,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
/* make sure we know there was no error yet */
Yap_ErrorMessage = NULL;
if ((botch_why = _setjmp(cglobs.cint.CompilerBotch))) {
if ((botch_why = sigsetjmp(cglobs.cint.CompilerBotch, 0))) {
restore_machine_regs();
reset_vars(cglobs.vtable);
Yap_ReleaseCMem(&cglobs.cint);
@ -3420,7 +3420,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
cglobs.vtable = NULL;
Yap_Error_Size = (256+maxvnum)*sizeof(CELL);
save_machine_regs();
_longjmp(cglobs.cint.CompilerBotch,3);
siglongjmp(cglobs.cint.CompilerBotch,3);
}
cglobs.Uses = (Int *)(H+maxvnum);
cglobs.Contents = (Term *)(H+maxvnum+(sizeof(Int)/sizeof(CELL))*MaxTemps);

6
C/computils.c
View File

@ -122,7 +122,7 @@ AllocCMem (UInt size, struct intermediates *cip)
if (!p) {
Yap_Error_Size = size;
save_machine_regs();
_longjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
}
Yap_CMemFirstBlock = p;
Yap_CMemFirstBlockSz = blksz;
@ -132,7 +132,7 @@ AllocCMem (UInt size, struct intermediates *cip)
if (!p) {
Yap_Error_Size = size;
save_machine_regs();
_longjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
}
}
p->u.next = cip->blks;
@ -152,7 +152,7 @@ AllocCMem (UInt size, struct intermediates *cip)
if (ASP <= CellPtr (cip->freep) + 256) {
Yap_Error_Size = 256+((char *)cip->freep - (char *)H);
save_machine_regs();
_longjmp(cip->CompilerBotch, OUT_OF_STACK_BOTCH);
siglongjmp(cip->CompilerBotch, OUT_OF_STACK_BOTCH);
}
return (p);
#endif

6
C/heapgc.c
View File

@ -165,7 +165,7 @@ gc_growtrail(int committed, tr_fr_ptr begsTR, cont *old_cont_top0)
#endif
/* could not find more trail */
save_machine_regs();
_longjmp(Yap_gc_restore, 2);
siglongjmp(Yap_gc_restore, 2);
}
}
@ -425,7 +425,7 @@ check_pr_trail(tr_fr_ptr trp)
if (!Yap_growtrail(0, TRUE) || TRUE) {
/* could not find more trail */
save_machine_regs();
_longjmp(Yap_gc_restore, 2);
siglongjmp(Yap_gc_restore, 2);
}
}
}
@ -3782,7 +3782,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
}
#endif
time_start = Yap_cputime();
if (_setjmp(Yap_gc_restore) == 2) {
if (sigsetjmp(Yap_gc_restore, 0) == 2) {
UInt sz;
/* we cannot recover, fail system */

52
C/index.c
View File

@ -188,7 +188,7 @@
* Revision 1.150 2005/12/23 00:20:13 vsc
* updates to gprof
* support for __POWER__
* Try to saveregs before _longjmp.
* Try to saveregs before siglongjmp.
*
* Revision 1.149 2005/12/17 03:25:39 vsc
* major changes to support online event-based profiling
@ -832,14 +832,14 @@ sort_group(GroupDef *grp, CELL *top, struct intermediates *cint)
if (!(base = (CELL *)Yap_AllocCodeSpace(2*max*sizeof(CELL)))) {
save_machine_regs();
Yap_Error_Size = 2*max*sizeof(CELL);
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
#else
base = top;
while (top+2*max > (CELL *)Yap_TrailTop) {
if (!Yap_growtrail(2*max*CellSize, TRUE)) {
save_machine_regs();
_longjmp(cint->CompilerBotch,4);
siglongjmp(cint->CompilerBotch,4);
return;
}
}
@ -2046,11 +2046,11 @@ groups_in(ClauseDef *min, ClauseDef *max, GroupDef *grp, struct intermediates *c
Yap_Error_Size = sz;
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,4);
siglongjmp(cint->CompilerBotch,4);
#else
if (!Yap_growtrail(sz, TRUE)) {
save_machine_regs();
_longjmp(cint->CompilerBotch,4);
siglongjmp(cint->CompilerBotch,4);
return 0;
}
#endif
@ -2179,7 +2179,7 @@ emit_switch_space(UInt n, UInt item_size, struct intermediates *cint, CELL func_
if (cl == NULL) {
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
Yap_LUIndexSpace_SW += sz;
cl->ClFlags = SwitchTableMask|LogUpdMask|func_mask;
@ -2199,7 +2199,7 @@ emit_switch_space(UInt n, UInt item_size, struct intermediates *cint, CELL func_
if (cl == NULL) {
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
Yap_IndexSpace_SW += sz;
cl->ClFlags = SwitchTableMask;
@ -2518,7 +2518,7 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi
sz = (UInt)NEXTOP((yamop *)NULL,sssllp)+tels*sizeof(yamop *);
if ((ncode = (yamop *)Yap_AllocCodeSpace(sz)) == NULL) {
save_machine_regs();
_longjmp(cint->CompilerBotch, 2);
siglongjmp(cint->CompilerBotch, 2);
}
#if DEBUG
Yap_ExpandClauses++;
@ -3130,7 +3130,7 @@ copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top, struct intermediates *
Yap_Error_Size = sz;
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,4);
siglongjmp(cint->CompilerBotch,4);
}
memcpy((void *)top, (void *)min0, sz);
return (ClauseDef *)top;
@ -3324,7 +3324,7 @@ compile_index(struct intermediates *cint)
Yap_Error_Size += NClauses*sizeof(ClauseDef);
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
}
cint->freep = (char *)H;
@ -3336,7 +3336,7 @@ compile_index(struct intermediates *cint)
Yap_Error_Size += NClauses*sizeof(ClauseDef);
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,3);
siglongjmp(cint->CompilerBotch,3);
}
cint->freep = (char *)(cint->cls+NClauses);
#endif
@ -3381,7 +3381,7 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc)
cint.cls = NULL;
Yap_Error_Size = 0;
if ((setjres = _setjmp(cint.CompilerBotch)) == 3) {
if ((setjres = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
restore_machine_regs();
recover_from_failed_susp_on_cls(&cint, 0);
if (!Yap_gcl(Yap_Error_Size, ap->ArityOfPE+NSlots, ENV, next_pc)) {
@ -3463,7 +3463,7 @@ push_stack(istack_entry *sp, Int arg, Term Tag, Term extra, struct intermediates
{
if (sp+1 > (istack_entry *)Yap_TrailTop) {
save_machine_regs();
_longjmp(cint->CompilerBotch,4);
siglongjmp(cint->CompilerBotch,4);
}
sp->pos = arg;
sp->val = Tag;
@ -4349,7 +4349,7 @@ expand_index(struct intermediates *cint) {
Yap_Error_Size += NClauses*sizeof(ClauseDef);
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
}
#else
@ -4359,7 +4359,7 @@ expand_index(struct intermediates *cint) {
Yap_Error_Size += 2*NClauses*sizeof(ClauseDef);
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,3);
siglongjmp(cint->CompilerBotch,3);
}
#endif
if (ap->PredFlags & LogUpdatePredFlag) {
@ -4377,7 +4377,7 @@ expand_index(struct intermediates *cint) {
Yap_Error_Size += NClauses*sizeof(ClauseDef);
/* grow stack */
save_machine_regs();
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
}
#else
@ -4386,7 +4386,7 @@ expand_index(struct intermediates *cint) {
/* tell how much space we need (worst case) */
Yap_Error_Size += 2*NClauses*sizeof(ClauseDef);
save_machine_regs();
_longjmp(cint->CompilerBotch,3);
siglongjmp(cint->CompilerBotch,3);
}
#endif
if (ap->PredFlags & LogUpdatePredFlag) {
@ -4485,7 +4485,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs, yamop *nextop) {
cint.cls = NULL;
cint.code_addr = NULL;
cint.label_offset = NULL;
if ((cb = _setjmp(cint.CompilerBotch)) == 3) {
if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
restore_machine_regs();
/* grow stack */
recover_from_failed_susp_on_cls(&cint, 0);
@ -4695,7 +4695,7 @@ push_path(path_stack_entry *sp, yamop **pipc, ClauseDef *clp, struct intermediat
{
if (sp+1 > (path_stack_entry *)Yap_TrailTop) {
save_machine_regs();
_longjmp(cint->CompilerBotch,4);
siglongjmp(cint->CompilerBotch,4);
}
sp->flag = pc_entry;
sp->u.pce.pi_pc = pipc;
@ -4711,7 +4711,7 @@ fetch_new_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct interm
{
if (sp+1 > (path_stack_entry *)Yap_TrailTop) {
save_machine_regs();
_longjmp(cint->CompilerBotch,4);
siglongjmp(cint->CompilerBotch,4);
}
/* add current position */
sp->flag = block_entry;
@ -5484,9 +5484,9 @@ add_try(PredEntry *ap, ClauseDef *cls, yamop *next, struct intermediates *cint)
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cls->Code);
if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
/* OOOPS, got in trouble, must do a _longjmp and recover space */
/* OOOPS, got in trouble, must do a siglongjmp and recover space */
save_machine_regs();
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
Yap_LUIndexSpace_CP += size;
#ifdef DEBUG
@ -5510,9 +5510,9 @@ add_trust(LogUpdIndex *icl, ClauseDef *cls, struct intermediates *cint)
PredEntry *ap = lcl->ClPred;
if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
/* OOOPS, got in trouble, must do a _longjmp and recover space */
/* OOOPS, got in trouble, must do a siglongjmp and recover space */
save_machine_regs();
_longjmp(cint->CompilerBotch,2);
siglongjmp(cint->CompilerBotch,2);
}
Yap_LUIndexSpace_CP += size;
#ifdef DEBUG
@ -6000,7 +6000,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
cint.CurrentPred = ap;
cint.expand_block = NULL;
cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NIL;
if ((cb = _setjmp(cint.CompilerBotch)) == 3) {
if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
restore_machine_regs();
Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);
save_machine_regs();
@ -6476,7 +6476,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
}
cint.expand_block = NULL;
cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NULL;
if ((cb = _setjmp(cint.CompilerBotch)) == 3) {
if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
restore_machine_regs();
Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);
save_machine_regs();

46
C/iopreds.c
View File

@ -827,12 +827,16 @@ IOSWIPutc(int sno, int ch)
static int
IOSWIGetc(int sno)
{
int i;
int ch;
Yap_StartSlots();
i = (SWIGetc)(Stream[sno].u.swi_stream.swi_ptr);
ch = (SWIGetc)(Stream[sno].u.swi_stream.swi_ptr);
if (ch == EOF) {
return post_process_eof(Stream+sno);
}
return post_process_read_char(ch, Stream+sno);
Yap_CloseSlots();
YENV = ENV;
return i;
return ch;
}
/* static */
@ -851,12 +855,16 @@ IOSWIWidePutc(int sno, int ch)
static int
IOSWIWideGetc(int sno)
{
int i;
int ch;
Yap_StartSlots();
i = (SWIWideGetc)(Stream[sno].u.swi_stream.swi_ptr);
ch = (SWIWideGetc)(Stream[sno].u.swi_stream.swi_ptr);
if (ch == EOF) {
return post_process_eof(Stream+sno);
}
return post_process_read_char(ch, Stream+sno);
Yap_CloseSlots();
YENV = ENV;
return i;
return ch;
}
#if USE_SOCKET
@ -4759,6 +4767,9 @@ StreamPosition(int sno)
Term sargs[5];
Int cpos;
cpos = Stream[sno].charcount;
if (Stream[sno].status & SWI_Stream_f) {
return Yap_get_stream_position(Stream[sno].u.swi_stream.swi_ptr);
}
if (Stream[sno].stream_getc == PlUnGetc) {
cpos--;
}
@ -5955,10 +5966,9 @@ p_format(void)
return res;
}
static Int
p_format2(void)
{ /* 'format'(Stream,Control,Args) */
format2(UInt stream_flag)
{
int old_c_stream = Yap_c_output_stream;
int mem_stream = FALSE, codes_stream = FALSE;
Int out;
@ -5977,7 +5987,7 @@ p_format2(void)
mem_stream = TRUE;
} else {
/* needs to change Yap_c_output_stream for write */
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3");
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f|stream_flag, "format/3");
}
UNLOCK(Stream[Yap_c_output_stream].streamlock);
if (Yap_c_output_stream == -1) {
@ -6009,6 +6019,18 @@ p_format2(void)
return out;
}
static Int
p_format2(void)
{ /* 'format'(Stream,Control,Args) */
return format2(0);
}
static Int
p_swi_format(void)
{ /* 'format'(Stream,Control,Args) */
return format2(SWI_Stream_f);
}
static Int
p_skip (void)
@ -6806,6 +6828,10 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$tolower", 2, p_tolower, SafePredFlag|HiddenPredFlag);
Yap_InitCPred ("file_base_name", 2, p_file_base_name, SafePredFlag|HiddenPredFlag);
CurrentModule = SYSTEM_MODULE;
Yap_InitCPred ("swi_format", 3, p_swi_format, SyncPredFlag);
CurrentModule = cm;
Yap_InitReadUtil ();
#if USE_SOCKET
Yap_InitSockets ();

12
C/parser.c
View File

@ -65,7 +65,7 @@ static char SccsId[] = "%W% %G%";
/* weak backtraking mechanism based on long_jump */
typedef struct jmp_buff_struct {
jmp_buf JmpBuff;
sigjmp_buf JmpBuff;
} JMPBUFF;
STATIC_PROTO(void GNextToken, (void));
@ -81,7 +81,7 @@ STATIC_PROTO(Term ParseTerm, (int, JMPBUFF *));
Volatile CELL *saveH=H; \
Volatile int savecurprio=curprio; \
saveenv=FailBuff; \
if(!_setjmp(newenv.JmpBuff)) { \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \
S; \
FailBuff=saveenv; \
@ -99,7 +99,7 @@ STATIC_PROTO(Term ParseTerm, (int, JMPBUFF *));
Volatile TokEntry *saveT=Yap_tokptr; \
Volatile CELL *saveH=H; \
saveenv=FailBuff; \
if(!_setjmp(newenv.JmpBuff)) { \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \
S; \
FailBuff=saveenv; \
@ -113,7 +113,7 @@ STATIC_PROTO(Term ParseTerm, (int, JMPBUFF *));
}
#define FAIL _longjmp(FailBuff->JmpBuff,1)
#define FAIL siglongjmp(FailBuff->JmpBuff,1)
VarEntry *
Yap_LookupVar(char *var) /* lookup variable in variables table */
@ -181,7 +181,7 @@ VarNames(VarEntry *p,Term l)
VarNames(p->VarLeft,l)));
if (H > ASP-4096) {
save_machine_regs();
_longjmp(Yap_IOBotch,1);
siglongjmp(Yap_IOBotch,1);
}
return(o);
} else {
@ -706,7 +706,7 @@ Yap_Parse(void)
Volatile Term t;
JMPBUFF FailBuff;
if (!_setjmp(FailBuff.JmpBuff)) {
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(1200, &FailBuff);
if (Yap_tokptr->Tok != Ord(eot_tok))
return (0L);

5
H/Yap.h
View File

@ -245,11 +245,6 @@ typedef unsigned long int YAP_ULONG_LONG;
#define LOW_PROF 1
#endif
#if !HAVE__SETJMP
#define _longjmp(A,B) longjmp(A,B)
#define _setjmp(A) setjmp(A)
#endif
#ifdef DEBUG
extern char Yap_Option[20];
#endif

1
H/YapHeap.h
View File

@ -29,6 +29,7 @@ typedef int (*SWI_GetWideFunction)(void *);
typedef int (*SWI_CloseFunction)(void *);
typedef int (*SWI_FlushFunction)(void *);
typedef int (*SWI_PLGetStreamFunction)(void *);
typedef int (*SWI_PLGetStreamPositionFunction)(void *);
#include "../include/dswiatoms.h"

16
H/YapOpcodes.h
View File

@ -67,8 +67,8 @@
OPCODE(get_struct ,xfa),
OPCODE(get_float ,xd),
OPCODE(get_longint ,xi),
OPCODE(get_bigint ,xc),
OPCODE(get_dbterm ,xc),
OPCODE(get_bigint ,xN),
OPCODE(get_dbterm ,xD),
OPCODE(glist_valx ,xx),
OPCODE(glist_valy ,yx),
OPCODE(gl_void_varx ,xx),
@ -125,10 +125,10 @@
OPCODE(unify_longint_write ,oi),
OPCODE(unify_l_longint ,oi),
OPCODE(unify_l_longint_write ,oi),
OPCODE(unify_bigint ,oc),
OPCODE(unify_l_bigint ,oc),
OPCODE(unify_dbterm ,oc),
OPCODE(unify_l_dbterm ,oc),
OPCODE(unify_bigint ,oN),
OPCODE(unify_l_bigint ,oN),
OPCODE(unify_dbterm ,oD),
OPCODE(unify_l_dbterm ,oD),
OPCODE(unify_list ,o),
OPCODE(unify_list_write ,o),
OPCODE(unify_l_list ,o),
@ -145,6 +145,8 @@
OPCODE(put_y_vals ,yyxx),
OPCODE(put_unsafe ,yx),
OPCODE(put_atom ,xc),
OPCODE(put_dbterm ,xD),
OPCODE(put_bigint ,xN),
OPCODE(put_float ,xd),
OPCODE(put_longint ,xi),
OPCODE(put_list ,x),
@ -158,6 +160,8 @@
OPCODE(write_y_val ,y),
OPCODE(write_y_loc ,y),
OPCODE(write_atom ,c),
OPCODE(write_bigint ,N),
OPCODE(write_dbterm ,D),
OPCODE(write_float ,d),
OPCODE(write_longint ,i),
OPCODE(write_n_atoms ,sc),

1
H/Yapproto.h
View File

@ -462,6 +462,7 @@ void STD_PROTO(Yap_InitMYDDAS_TopLevelPreds,(void));
void STD_PROTO(Yap_swi_install,(void));
void STD_PROTO(Yap_InitSWIHash,(void));
int STD_PROTO(Yap_get_stream_handle,(Term, int, int, void *));
Term STD_PROTO(Yap_get_stream_position,(void *));
/* ypsocks.c */
void STD_PROTO(Yap_InitSockets,(void));

29
H/amidefs.h
View File

@ -252,6 +252,7 @@ typedef enum {
L: logic upd clause, logic_upd_clause *
m: module, Term
n: number, Integer
N: bigint, Blob (Term)
o: opcode, OPCODE
O: OR-parallel information, used by YAPOR, unsigned int
p: predicate, struct pred_entry *
@ -276,6 +277,14 @@ typedef struct yami {
Term c;
CELL next;
} c;
struct {
Term D;
CELL next;
} D;
struct {
Term b;
CELL next;
} N;
struct {
Term c1;
Term c2;
@ -496,11 +505,21 @@ typedef struct yami {
Term c;
CELL next;
} oc;
struct {
OPCODE opcw;
Term b;
CELL next;
} oN;
struct {
OPCODE opcw;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
CELL next;
} od;
struct {
OPCODE opcw;
Term D;
CELL next;
} oD;
struct {
OPCODE opcw;
Functor f;
@ -705,11 +724,21 @@ typedef struct yami {
CELL c;
CELL next;
} xc;
struct {
wamreg x;
Term b;
CELL next;
} xN;
struct {
wamreg x;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
CELL next;
} xd;
struct {
wamreg x;
Term D;
CELL next;
} xD;
struct {
wamreg x;
Functor f;

2
H/compile.h
View File

@ -263,7 +263,7 @@ typedef struct intermediates {
Int *uses;
Term *contents;
struct pred_entry *CurrentPred;
jmp_buf CompilerBotch;
sigjmp_buf CompilerBotch;
yamop *code_addr;
yamop *expand_block;
UInt i_labelno;

1
H/dglobals.h
View File

@ -188,6 +188,7 @@
#define SWIClose Yap_global->swi_close
#define SWIFlush Yap_global->swi_flush
#define SWIGetStream Yap_global->swi_get_stream_f
#define SWIGetStreamPosition Yap_global->swi_get_stream_position_f
#define Yap_AllowLocalExpansion Yap_global->allow_local_expansion
#define Yap_AllowGlobalExpansion Yap_global->allow_global_expansion

57
H/findclause.h
View File

@ -6,9 +6,15 @@
while (TRUE) {
op_numbers op = Yap_op_from_opcode(cl->opc);
switch (op) {
case _write_dbterm:
cl = NEXTOP(cl,D);
break;
case _alloc_for_logical_pred:
cl = NEXTOP(cl,L);
break;
case _write_bigint:
cl = NEXTOP(cl,N);
break;
case _ensure_space:
cl = NEXTOP(cl,Osbpi);
break;
@ -316,30 +322,30 @@
case _unify_void_write:
cl = NEXTOP(cl,o);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_float:
cl = NEXTOP(cl,od);
break;
@ -656,19 +662,28 @@
}
cl = NEXTOP(cl,x);
break;
case _get_atom:
if (is_regcopy(myregs, nofregs, cl->u.xc.x)) {
if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.xc.c;
} else
clause->Tag = cl->u.xc.c;
case _put_dbterm:
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.xD.x))) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xc);
cl = NEXTOP(cl,xD);
break;
case _get_bigint:
if (is_regcopy(myregs, nofregs, cl->u.xN.x)) {
clause->Tag = cl->u.xN.b;
return;
}
cl = NEXTOP(cl,xN);
break;
case _put_bigint:
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.xN.x))) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xN);
break;
case _get_atom:
if (is_regcopy(myregs, nofregs, cl->u.xc.x)) {
if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c);

51
H/headclause.h
View File

@ -291,30 +291,30 @@
case _unify_void_write:
cl = NEXTOP(cl,o);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_float:
cl = NEXTOP(cl,od);
break;
@ -553,19 +553,28 @@
}
cl = NEXTOP(cl,x);
break;
case _get_atom:
if (iarg == cl->u.xc.x) {
if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.t_ptr = cl->u.xc.c;
} else
clause->Tag = cl->u.xc.c;
case _put_dbterm:
if (iarg == cl->u.xD.x) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xc);
cl = NEXTOP(cl,xD);
break;
case _get_bigint:
if (iarg == cl->u.xN.x) {
clause->Tag = cl->u.xN.b;
return;
}
cl = NEXTOP(cl,xN);
break;
case _put_bigint:
if (iarg == cl->u.xN.x) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xN);
break;
case _get_atom:
if (iarg == cl->u.xc.x) {
if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c);

3
H/hglobals.h
View File

@ -135,7 +135,7 @@ typedef struct worker_local {
struct RB_red_blk_node* DB_root;
struct RB_red_blk_node* DB_nil;
#endif /* defined(YAPOR) || defined(THREADS) */
jmp_buf gc_restore;
sigjmp_buf gc_restore;
struct array_entry* dynamic_arrays;
struct static_array_entry* static_arrays;
struct global_entry* global_variables;
@ -190,6 +190,7 @@ typedef struct worker_shared {
SWI_CloseFunction swi_close;
SWI_FlushFunction swi_flush;
SWI_PLGetStreamFunction swi_get_stream_f;
SWI_PLGetStreamPositionFunction swi_get_stream_position_f;
int allow_local_expansion;
int allow_global_expansion;

1
H/iglobals.h
View File

@ -188,6 +188,7 @@ static void InitGlobal(void) {
Yap_global->swi_close = NULL;
Yap_global->swi_flush = NULL;
Yap_global->swi_get_stream_f = NULL;
Yap_global->swi_get_stream_position_f = NULL;
Yap_global->allow_local_expansion = TRUE;
Yap_global->allow_global_expansion = TRUE;

44
H/rclause.h
View File

@ -16,6 +16,11 @@ restore_opcodes(yamop *pc, yamop *max)
fprintf(stderr, "%s ", Yap_op_names[op]);
#endif
switch (op) {
/* instructions type D */
case _write_dbterm:
pc->u.D.D = DBGroundTermAdjust(pc->u.D.D);
pc = NEXTOP(pc,D);
break;
/* instructions type Ills */
case _enter_lu_pred:
pc->u.Ills.I = PtoLUIndexAdjust(pc->u.Ills.I);
@ -30,6 +35,11 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.L.ClBase = PtoLUClauseAdjust(pc->u.L.ClBase);
pc = NEXTOP(pc,L);
break;
/* instructions type N */
case _write_bigint:
pc->u.N.b = BlobTermInCodeAdjust(pc->u.N.b);
pc = NEXTOP(pc,N);
break;
/* instructions type Osblp */
case _either:
case _or_else:
@ -294,15 +304,25 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.o.opcw = OpcodeAdjust(pc->u.o.opcw);
pc = NEXTOP(pc,o);
break;
/* instructions type oD */
case _unify_dbterm:
case _unify_l_dbterm:
pc->u.oD.opcw = OpcodeAdjust(pc->u.oD.opcw);
pc->u.oD.D = DBGroundTermAdjust(pc->u.oD.D);
pc = NEXTOP(pc,oD);
break;
/* instructions type oN */
case _unify_bigint:
case _unify_l_bigint:
pc->u.oN.opcw = OpcodeAdjust(pc->u.oN.opcw);
pc->u.oN.b = BlobTermInCodeAdjust(pc->u.oN.b);
pc = NEXTOP(pc,oN);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
case _unify_bigint:
case _unify_dbterm:
case _unify_l_atom:
case _unify_l_atom_write:
case _unify_l_bigint:
case _unify_l_dbterm:
pc->u.oc.opcw = OpcodeAdjust(pc->u.oc.opcw);
pc->u.oc.c = ConstantTermAdjust(pc->u.oc.c);
pc = NEXTOP(pc,oc);
@ -525,10 +545,22 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.x.x = XAdjust(pc->u.x.x);
pc = NEXTOP(pc,x);
break;
/* instructions type xD */
case _get_dbterm:
case _put_dbterm:
pc->u.xD.x = XAdjust(pc->u.xD.x);
pc->u.xD.D = DBGroundTermAdjust(pc->u.xD.D);
pc = NEXTOP(pc,xD);
break;
/* instructions type xN */
case _get_bigint:
case _put_bigint:
pc->u.xN.x = XAdjust(pc->u.xN.x);
pc->u.xN.b = BlobTermInCodeAdjust(pc->u.xN.b);
pc = NEXTOP(pc,xN);
break;
/* instructions type xc */
case _get_atom:
case _get_bigint:
case _get_dbterm:
case _put_atom:
pc->u.xc.x = XAdjust(pc->u.xc.x);
pc->u.xc.c = ConstantTermAdjust(pc->u.xc.c);

1
H/rglobals.h
View File

@ -199,6 +199,7 @@ static void RestoreGlobal(void) {
#if HAVE_LIBREADLINE

17
H/rheap.h
View File

@ -244,14 +244,17 @@ ConstantTermAdjust (Term t)
{
if (IsAtomTerm(t))
return AtomTermAdjust(t);
else if (IsIntTerm(t))
return t;
else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
return BlobTermAdjust(t);
} else if (IsApplTerm(t) || IsPairTerm(t)) {
return CodeComposedTermAdjust(t);
return t;
}
static Term
DBGroundTermAdjust (Term t)
{
/* The term itself is restored by dbtermlist */
if (IsPairTerm(t)) {
return AbsPair(PtoHeapCellAdjust(RepPair(t)));
} else {
return t;
return AbsAppl(PtoHeapCellAdjust(RepAppl(t)));
}
}

8
H/sshift.h
View File

@ -449,10 +449,10 @@ CodeVarAdjust (Term var)
#if TAGS_FAST_OPS
inline EXTERN Term BlobTermAdjust (Term);
inline EXTERN Term BlobTermInCodeAdjust (Term);
inline EXTERN Term
BlobTermAdjust (Term t)
BlobTermInCodeAdjust (Term t)
{
return (Term) (CharP(t) - HDiff);
}
@ -469,10 +469,10 @@ CodeComposedTermAdjust (Term t)
#else
inline EXTERN Term BlobTermAdjust (Term);
inline EXTERN Term BlobTermInCodeAdjust (Term);
inline EXTERN Term
BlobTermAdjust (Term t)
BlobTermInCodeAdjust (Term t)
{
return (Term) (CharP(t) + HDiff);
}

34
H/walkclause.h
View File

@ -9,12 +9,20 @@
op = Yap_op_from_opcode(pc->opc);
/* C-code, maybe indexing */
switch (op) {
/* instructions type D */
case _write_dbterm:
pc = NEXTOP(pc,D);
break;
/* instructions type Ills */
case _enter_lu_pred:
return walk_got_lu_block(pc->u.Ills.I, startp, endp);
/* instructions type L */
case _alloc_for_logical_pred:
return walk_got_lu_clause(pc->u.L.ClBase, startp, endp);
/* instructions type N */
case _write_bigint:
pc = NEXTOP(pc,N);
break;
/* instructions type Osblp */
case _either:
case _or_else:
@ -225,15 +233,21 @@
case _unify_void_write:
pc = NEXTOP(pc,o);
break;
/* instructions type oD */
case _unify_dbterm:
case _unify_l_dbterm:
pc = NEXTOP(pc,oD);
break;
/* instructions type oN */
case _unify_bigint:
case _unify_l_bigint:
pc = NEXTOP(pc,oN);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
case _unify_bigint:
case _unify_dbterm:
case _unify_l_atom:
case _unify_l_atom_write:
case _unify_l_bigint:
case _unify_l_dbterm:
pc = NEXTOP(pc,oc);
break;
/* instructions type od */
@ -400,10 +414,18 @@
case _write_x_var:
pc = NEXTOP(pc,x);
break;
/* instructions type xD */
case _get_dbterm:
case _put_dbterm:
pc = NEXTOP(pc,xD);
break;
/* instructions type xN */
case _get_bigint:
case _put_bigint:
pc = NEXTOP(pc,xN);
break;
/* instructions type xc */
case _get_atom:
case _get_bigint:
case _get_dbterm:
case _put_atom:
pc = NEXTOP(pc,xc);
break;

1
config.h.in
View File

@ -167,7 +167,6 @@
#undef RETSIGTYPE
#undef HAVE__NSGETENVIRON
#undef HAVE__SETJMP
#undef HAVE_ACCESS
#undef HAVE_ACOSH
#undef HAVE_ALARM

493
configure vendored
View File

File diff suppressed because it is too large Load Diff

20
configure.in
View File

@ -1567,26 +1567,6 @@ else
AC_DEFINE(HAVE_SIGSETJMP,0)
fi
dnl check for _setjmp
AC_MSG_CHECKING(for _setjmp)
AC_CACHE_VAL(yap_cv__setjmp,[
AC_TRY_COMPILE(
#include <setjmp.h>
,
jmp_buf RestartEnv;
_setjmp (RestartEnv);
_longjmp (RestartEnv, 1);
,
yap_cv__setjmp=yes,yap_cv__setjmp=no)])
AC_MSG_RESULT($yap_cv__setjmp)
if test "$yap_cv__setjmp" = yes
then
AC_DEFINE(HAVE__SETJMP,1)
else
AC_DEFINE(HAVE__SETJMP,0)
fi
dnl check for sigsegv
AC_MSG_CHECKING(for sigsegv)
AC_CACHE_VAL(yap_cv_sigsegv,[

1
include/SWI-Prolog.h
View File

@ -699,6 +699,7 @@ typedef struct SWI_IO {
void *flush_s;
void *close_s;
void *get_stream_handle;
void *get_stream_position;
} swi_io_struct;
/* SWI stream info */

4
library/dialect/swi.yap
View File

@ -242,6 +242,10 @@ goal_expansion(print(A),write_term(user_output,A,[swi(true),portray(true),number
goal_expansion(print(S,A),write_term(S,A,[swi(true),portray(true),numbervars(true)])) :- swi_io.
goal_expansion(write_term(A,Opts),write_term(user_output,A,Opts,[swi(true)|Opts])) :- swi_io.
goal_expansion(write_term(S,A,Opts),write_term(S,A,[swi(true)|Opts])) :- swi_io, \+ member(swi(_), Opts).
goal_expansion(format(A),system:swi_format(user_output,A,[])) :- swi_io.
goal_expansion(format(A,Args),system:swi_format(user_output,A,Args)) :- swi_io.
goal_expansion(format(S,A,Args),system:swi_format(S,A,Args)) :- swi_io.
goal_expansion(writeln(A),system:swi_format(user_output,'~w~n',[A])) :- swi_io.
% make sure we also use

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

@ -459,22 +459,35 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
if (IsWideAtom(at)) {
size_t sz = wcslen(RepAtom(at)->WStrOfAE)*sizeof(wchar_t);
if (!(tmp = ensure_space(sp, (sz+1)*sizeof(wchar_t), flags)))
wchar_t* s = RepAtom(at)->WStrOfAE;
size_t sz = wcslen(s)+1;
if (!(tmp = ensure_space(sp, sz*sizeof(wchar_t), flags)))
return 0;
memcpy(*sp,s,sz*sizeof(wchar_t));
} else {
char *s = RepAtom(at)->StrOfAE;
size_t sz = strlen(RepAtom(at)->StrOfAE)+1;
size_t sz = strlen(s)+1;
if (!(tmp = ensure_space(sp, sz, flags)))
return 0;
strncpy(*sp,s,sz);
memcpy(*sp,s,sz);
}
} else if (IsNumTerm(t)) {
if (IsFloatTerm(t)) {
if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
snprintf(tmp,SWI_BUF_SIZE,"%f",FloatOfTerm(t));
#if USE_GMP
} else if (YAP_IsBigNumTerm(t)) {
if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
MP_INT g;
YAP_BigNumOfTerm(t, (void *)&g);
if (mpz_sizeinbase(&g,2) > SWI_BUF_SIZE-1) {
return 0;
}
mpz_get_str (tmp, 10, &g);
#endif
} else {
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
@ -520,7 +533,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
char *nbf = PL_malloc(sz+1);
if (!nbf)
return 0;
strncpy(nbf,tmp,sz+1);
memcpy(nbf,tmp,sz+1);
free(tmp);
*sp = nbf;
}
@ -890,7 +903,7 @@ X_API atom_t PL_new_atom_nchars(size_t len, const char *c)
return 0L;
}
}
strncpy(pt, c, len);
memcpy(pt, c, len);
pt[len] = '\0';
} else {
pt = (char *)c;
@ -1102,7 +1115,8 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s)
return FALSE;
}
}
strncpy(buf, s, len);
memcpy(buf, s, len);
buf[len] = 0;
} else {
buf = (char *)s;
}
@ -1547,7 +1561,7 @@ X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s)
if (!buf)
return FALSE;
strncpy(buf, s, len);
memcpy(buf, s, len);
buf[len] = '\0';
while (!(catom = Yap_LookupAtom(buf))) {
if (!Yap_growheap(FALSE, 0L, NULL)) {
@ -1857,7 +1871,7 @@ LookupMaxAtom(size_t n, char *s)
if (!buf)
return FALSE;
strncpy(buf, s, n);
memcpy(buf, s, n);
buf[n] = '\0';
while (!(catom = Yap_LookupAtom(buf))) {
if (!Yap_growheap(FALSE, 0L, NULL)) {
@ -2212,7 +2226,7 @@ X_API int PL_is_float(term_t ts)
X_API int PL_is_integer(term_t ts)
{
YAP_Term t = Yap_GetFromSlot(ts);
return YAP_IsIntTerm(t);
return YAP_IsIntTerm(t) || YAP_IsBigNumTerm(t);
}
X_API int PL_is_list(term_t ts)
@ -2224,7 +2238,7 @@ X_API int PL_is_list(term_t ts)
X_API int PL_is_number(term_t ts)
{
YAP_Term t = Yap_GetFromSlot(ts);
return YAP_IsIntTerm(t) || YAP_IsFloatTerm(t);
return YAP_IsIntTerm(t) || YAP_IsBigNumTerm(t) || YAP_IsFloatTerm(t);
}
X_API int PL_is_string(term_t ts)
@ -3096,6 +3110,7 @@ PL_YAP_InitSWIIO(struct SWI_IO *swio)
SWIFlush = swio->flush_s;
SWIClose = swio->close_s;
SWIGetStream = swio->get_stream_handle;
SWIGetStreamPosition = swio->get_stream_position;
}
typedef int (*GetStreamF)(term_t, int, int, IOSTREAM **s);
@ -3115,6 +3130,23 @@ Yap_get_stream_handle(Term t0, int read_mode, int write_mode, void *s){
}
typedef int (*GetStreamPosF)(IOSTREAM *s, term_t);
Term
Yap_get_stream_position(void *s){
term_t t;
Term t0;
GetStreamPosF f = (GetStreamPosF)SWIGetStreamPosition;
t = (term_t)Yap_NewSlots(1);
if (!(*f)(s, t))
return 0L;
t0 = Yap_GetFromSlot((Int)t);
Yap_RecoverSlots(1);
return t0;
}
X_API void (*PL_signal(int sig, void (*func)(int)))(int)
{
// return Yap_signal2(sig,func);

2
library/tries/base_tries.c
View File

@ -203,7 +203,7 @@ TrData trie_traverse_init(TrEntry trie, TrData init_data) {
if (CURRENT_TRAVERSE_MODE == TRAVERSE_MODE_FORWARD)
data = TrEntry_first_data(trie);
else
data = TrEntry_last_data(trie);
data = trie_get_last_entry(trie);
}
TrEntry_traverse_data(trie) = data;
return data;

3
misc/GLOBALS
View File

@ -144,7 +144,7 @@ struct RB_red_blk_node* DB_nil db_nil =NULL
#endif /* defined(YAPOR) || defined(THREADS) */
jmp_buf gc_restore Yap_gc_restore void
sigjmp_buf gc_restore Yap_gc_restore void
struct array_entry* dynamic_arrays DynamicArrays =NULL PtoArrayEAdjust
struct static_array_entry* static_arrays StaticArrays =NULL PtoArraySAdjust
struct global_entry* global_variables GlobalVariables =NULL PtoGlobalEAdjust
@ -211,6 +211,7 @@ SWI_PutWideFunction swi_wputc SWIWidePutc =NULL
SWI_CloseFunction swi_close SWIClose =NULL
SWI_FlushFunction swi_flush SWIFlush =NULL
SWI_PLGetStreamFunction swi_get_stream_f SWIGetStream =NULL
SWI_PLGetStreamPositionFunction swi_get_stream_position_f SWIGetStreamPosition =NULL
// stack overflow expansion/gc control
int allow_local_expansion Yap_AllowLocalExpansion =TRUE

6
misc/buildops
View File

@ -224,6 +224,7 @@ get_op(0'a,"Arity").
get_op(0'b,"CellPtoHeap").
get_op(0'c,"ConstantTerm").
get_op(0'd,"DoubleInCode").
get_op(0'D,"DBGroundTerm").
get_op(0'f,"Func").
get_op(0'F,"ExternalFunction").
get_op(0'i,"IntegerInCode").
@ -232,6 +233,7 @@ get_op(0'l,"PtoOp").
get_op(0'L,"PtoLUClause").
get_op(0'm,"Module").
get_op(0'n,"Integer").
get_op(0'N,"BlobTermInCode").
get_op(0'o,"Opcode").
get_op(0'O,"OrArg").
get_op(0'p,"PtoPred").
@ -850,10 +852,12 @@ opinfo("gl_void_vary",[bind("y","AbsPair(NULL)",workpc=currentop),new("y")]).
opinfo("get_struct",[bind("x","AbsAppl((CELL *)cl->u.xfa.f)",workpc=nextop)]).
opinfo("get_float",[bind("x","AbsAppl((CELL *)FunctorDouble)",t_ptr="d")]).
opinfo("get_longint",[bind("x","AbsAppl((CELL *)FunctorLongInt)",t_ptr="i")]).
opinfo("get_bigint",[bind("x","c",[])]).
opinfo("get_bigint",[bind("x","b",[])]).
opinfo("copy_idb_term",[logical]).
opinfo("unify_idb_term",[logical]).
opinfo("put_atom",[new("x")]).
opinfo("put_dbterm",[new("x")]).
opinfo("put_bigint",[new("x")]).
opinfo("put_float",[new("x")]).
opinfo("put_longint",[new("x")]).
opinfo("put_list",[new("x")]).

7
packages/PLStream/pl-file.c
View File

@ -4350,6 +4350,12 @@ get_stream_handle_no_errors(term_t t, int read, int write, IOSTREAM **s)
return get_stream_handle(t, s, SH_ALIAS);
}
static int
get_stream_position(IOSTREAM *s, term_t t)
{ GET_LD
return stream_position_prop(s, t);
}
static void
init_yap_extras(void)
{
@ -4363,6 +4369,7 @@ init_yap_extras(void)
swiio.flush_s = Sflush;
swiio.close_s = closeStream;
swiio.get_stream_handle = get_stream_handle_no_errors;
swiio.get_stream_position = get_stream_position;
PL_YAP_InitSWIIO(&swiio);
initCharTypes();
initFiles();

1
packages/ProbLog/dtproblog.yap
View File

@ -707,6 +707,7 @@ bdd_optimization(N,EV,Decisions,Status) :-
%(problog_flag(verbose,true) -> Debug = ' -d';Debug = ''), % messes up result parsing
atomic_concat([ProblogBDD, Param, ' -l ',BDDFile,' -i ',BDDParFile,' -u ',UtilFile,' -m s',LocalPar,Forest,' -t ', BDDTime,' > ', ResultFile],Command),
statistics(walltime,_),
% format(user,'$ ~w~n',[Command]),
shell(Command,Return),
(Return =\= 0 ->
Status = timeout

68
packages/ProbLog/problog.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-11-23 11:47:48 +0100 (Tue, 23 Nov 2010) $
% $Revision: 5027 $
% $Date: 2010-12-15 11:12:48 +0100 (Wed, 15 Dec 2010) $
% $Revision: 5138 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog
@ -350,16 +350,13 @@
:- use_module('problog/mc_DNF_sampling').
:- use_module('problog/timer').
:- use_module('problog/utils').
:- catch(use_module('problog/ad_converter'),_,true).
:- use_module('problog/ad_converter').
:- catch(use_module('problog/variable_elimination'),_,true).
% op attaching probabilities to facts
:- op( 550, yfx, :: ).
:- op( 550, fx, ?:: ).
% for annotated disjunctions
% :- op(1149, yfx, <-- ).
%%%%%%%%%%%%%%%%%%%%%%%%
% control predicates on various levels
%%%%%%%%%%%%%%%%%%%%%%%%
@ -509,7 +506,7 @@ problog_dir(PD):- problog_path(PD).
%%%%%%%%%%%%%%%%%%%%%%%%
init_global_params :-
%grow_atom_table(1000000),
grow_atom_table(1000000), % this will reserve us some memory, there are cases where you might need more
%%%%%%%%%%%%
% working directory: all the temporary and output files will be located there
@ -591,9 +588,9 @@ generate_atoms(N, A):-
% dynamic predicate problog_predicate(Name,Arity) keeps track of predicates that already have wrapper clause
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% converts annotated disjunctions - if loaded
term_expansion_intern(A, B, C):-
catch(term_expansion_intern_ad(A, B, C), _, false).
% converts annotated disjunctions
term_expansion_intern(A, Module, C):-
term_expansion_intern_ad(A, Module, C).
% converts ?:: prefix to ? :: infix, as handled by other clause
term_expansion_intern((Annotation::Fact), Module, ExpandedClause) :-
@ -667,13 +664,12 @@ term_expansion_intern(Head :: Goal,Module,problog:ProbFact) :-
)
),
copy_term(((X,Distribution) :: Goal), ((X2,Distribution2) :: Goal2)),
% bind_the_variable
X2=Distribution2,
X=Distribution,
% find position in term
Goal2=..[Name|Args],
once(nth1(Pos,Args,Distribution2)),
Goal=..[Name|Args],
once(nth1(Pos,Args,Distribution)),
length(Args,Arity),
atomic_concat([problogcontinuous_,Name],ProblogName),
@ -1165,31 +1161,20 @@ set_continuous_fact_parameters(ID,Parameters) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% writing those facts with learnable parameters to File
% writing all probabilistic and continuous facts to Filename
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
export_facts(Filename) :-
open(Filename,'write',Handle),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
( % go over all probabilistic facts
P::Goal,
format(Handle,'~w :: ~q.~n',[P,Goal]),
forall(P::Goal,
format(Handle,'~10f :: ~q.~n',[P,Goal])),
fail; % go to next prob. fact
true
),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
( % go over all continuous facts
continuous_fact(ID),
get_continuous_fact_parameters(ID,Param),
format(Handle,'~q. % ~q~n',[Param,ID]),
fail; % go to next cont. fact
true
),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
forall(continuous_fact(ID),
(
get_continuous_fact_parameters(ID,Param),
format(Handle,'~q. % ~q~n',[Param,ID])
)
),
close(Handle).
@ -1946,14 +1931,12 @@ disjoin_hybrid_proofs([GroundID|T]) :-
intervals_partition(Intervals,Partition),
% go over all proofs where this fact occurs
(
hybrid_proof(ProofID,ID,GroundID,Interval),
intervals_disjoin(Interval,Partition,PInterval),
assertz(hybrid_proof_disjoint(ProofID,ID,GroundID,PInterval)),
fail; % go to next proof
true
),
forall(hybrid_proof(ProofID,ID,GroundID,Interval),
(
intervals_disjoin(Interval,Partition,PInterval),
assertz(hybrid_proof_disjoint(ProofID,ID,GroundID,PInterval))
)
),
disjoin_hybrid_proofs(T).
@ -1996,6 +1979,7 @@ problog_low(_, _, LP, Status) :-
timer_stop(sld_time,SLD_Time),
problog_var_set(sld_time, SLD_Time),
nb_getval(problog_completed_proofs, Trie_Completed_Proofs),
%print_nested_ptree(Trie_Completed_Proofs),
eval_dnf(Trie_Completed_Proofs, LP, Status),
(problog_flag(verbose, true)->
problog_statistics

128
packages/ProbLog/problog/ad_converter.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-10-13 17:09:47 +0200 (Wed, 13 Oct 2010) $
% $Revision: 4915 $
% $Date: 2010-12-13 18:15:14 +0100 (Mon, 13 Dec 2010) $
% $Revision: 5125 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog
@ -214,51 +214,64 @@
]).
% general yap modules
:- use_module(library(lists),[reverse/2]).
:- use_module(library(lists),[reverse/2,member/2,append/3]).
:- use_module(flags).
:- style_check(all).
:- yap_flag(unknown,error).
:- discontiguous user:ad_intern/2.
:- op( 550, yfx, :: ).
% for annotated disjunctions
:- op(1149, yfx, <-- ).
:- initialization(problog_define_flag(show_ad_compilation,problog_flag_validate_boolean,'show compiled code for ADs',false,annotated_disjunctions)).
:- initialization(problog_define_flag(ad_cpl_semantics,problog_flag_validate_boolean,'use CP-logics semantics for ADs',true,annotated_disjunctions)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
term_expansion_intern_ad( (Head<--Body),Module,ad_intern((Head<--Body),ID)) :-
proper_tunable_annotated_disjunction(Head),
!,
compile_tunable_annotated_disjunction(Head,Body,Facts,Bodies,ID),
assert_all_ad_facts(Facts,Module),
assert_all_ad_bodies(Bodies,Module).
term_expansion_intern_ad( (Head<--Body),Module,ad_intern((Head<--Body),ID)) :-
proper_annotated_disjunction(Head),
!,
compile_annotated_disjunction(Head,Body,Facts,Bodies,ID),
assert_all_ad_facts(Facts,Module),
assert_all_ad_bodies(Bodies,Module).
problog_flag(ad_cpl_semantics,AD_CPL_Semantics),
(
proper_tunable_annotated_disjunction(Head)
->
compile_tunable_annotated_disjunction(Head,Body,Facts,Bodies,ID,AD_CPL_Semantics);
(
proper_annotated_disjunction(Head),
compile_annotated_disjunction(Head,Body,Facts,Bodies,ID,AD_CPL_Semantics)
)
),
forall(member(F,Facts),(once(problog:term_expansion_intern(F,Module,Atom)),
assertz(problog:Atom))),
forall(member(B,Bodies),assertz(Module:B)),
problog_flag(show_ad_compilation,Show_AD_compilation),
(
Show_AD_compilation==true
->
(
format('Compiling the annotated disjunction~n ~q~ninto the following code~n',[(Head<--Body)]),
format('================================================~n',[]),
forall(member(F,Facts),format(' ~q.~n',[F])),
format(' - - - - - - - - - - - - - - - - - - - - - - ~n',[]),
forall(member(B,Bodies),format(' ~q.~n',[B])),
format('================================================~2n',[])
);
true
).
term_expansion_intern_ad( (Head<--Body),_,_) :-
format_to_chars('Error at compiling the annotated disjunction ~q<--Body.',[Head,Body],Error),
print_message(error,Error),
fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
assert_all_ad_facts([],_).
assert_all_ad_facts([F|T],Module) :-
once(problog:term_expansion_intern(F,Module,Atom)),
assertz(problog:Atom),
assert_all_ad_facts(T,Module).
assert_all_ad_bodies([],_).
assert_all_ad_bodies([B|T],Module) :-
assertz(Module:B),
assert_all_ad_bodies(T,Module).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
@ -303,22 +316,36 @@ proper_tunable_annotated_disjunction((X;Y)) :-
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
compile_tunable_annotated_disjunction(Head,Body,Facts2,Bodies2,Extra_ID) :-
compile_tunable_annotated_disjunction(Head,Body,Facts2,Bodies2,Extra_ID,AD_CPL_Semantics) :-
get_next_unique_id(Extra_ID),
(
AD_CPL_Semantics==true
->
term_variables(Body,Body_Vars);
Body_Vars=[]
),
convert_a_tunable(Head,Extra_ID,[],Facts),
convert_b(Head,Body,_NewBody,Extra_ID,[],Bodies),
convert_a_tunable(Head,Extra_ID,[],Facts,Body_Vars),
convert_b(Head,Body,_NewBody,Extra_ID,[],Bodies,Body_Vars),
reverse(Facts,Facts2),
reverse(Bodies,Bodies2).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
compile_annotated_disjunction(Head,Body,Facts2,Bodies2,Extra_ID) :-
compile_annotated_disjunction(Head,Body,Facts2,Bodies2,Extra_ID,AD_CPL_Semantics) :-
get_next_unique_id(Extra_ID),
(
AD_CPL_Semantics==true
->
term_variables(Body,Body_Vars);
Body_Vars=[]
),
convert_a(Head,0.0,_Acc,Extra_ID,[],Facts),
convert_b(Head,Body,_NewBody,Extra_ID,[],Bodies),
convert_a(Head,0.0,_Acc,Extra_ID,[],Facts,Body_Vars),
convert_b(Head,Body,_NewBody,Extra_ID,[],Bodies,Body_Vars),
reverse(Facts,Facts2),
reverse(Bodies,Bodies2).
@ -326,16 +353,17 @@ compile_annotated_disjunction(Head,Body,Facts2,Bodies2,Extra_ID) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
convert_a((X;Y),OldAcc,Acc,Extra_ID,OldFacts,Facts) :-
convert_a(X,OldAcc,NewAcc,Extra_ID,OldFacts,NewFacts),
convert_a(Y,NewAcc,Acc,Extra_ID,NewFacts,Facts).
convert_a(P::Atom,OldAcc,NewAcc,Extra_ID,OldFacts,[P1::ProbFact|OldFacts]) :-
convert_a((X;Y),OldAcc,Acc,Extra_ID,OldFacts,Facts,Body_Vars) :-
convert_a(X,OldAcc,NewAcc,Extra_ID,OldFacts,NewFacts,Body_Vars),
convert_a(Y,NewAcc,Acc,Extra_ID,NewFacts,Facts,Body_Vars).
convert_a(P::Atom,OldAcc,NewAcc,Extra_ID,OldFacts,[P1::ProbFact|OldFacts],Body_Vars) :-
Atom =.. [Functor|AllArguments],
append(AllArguments,Body_Vars,NewAllArguments),
length(AllArguments,Arity),
atomic_concat([mvs_fact_,Functor,'_',Arity,'_',Extra_ID],NewAtom),
ProbFact =.. [NewAtom|AllArguments],
ProbFact =.. [NewAtom|NewAllArguments],
(
P=:=0
->
@ -351,29 +379,31 @@ convert_a(P::Atom,OldAcc,NewAcc,Extra_ID,OldFacts,[P1::ProbFact|OldFacts]) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
convert_a_tunable((X;Y),Extra_ID,OldFacts,Facts) :-
convert_a_tunable(X,Extra_ID,OldFacts,NewFacts),
convert_a_tunable(Y,Extra_ID,NewFacts,Facts).
convert_a_tunable(P::Atom,Extra_ID,OldFacts,[P::ProbFact|OldFacts]) :-
convert_a_tunable((X;Y),Extra_ID,OldFacts,Facts,Body_Vars) :-
convert_a_tunable(X,Extra_ID,OldFacts,NewFacts,Body_Vars),
convert_a_tunable(Y,Extra_ID,NewFacts,Facts,Body_Vars).
convert_a_tunable(P::Atom,Extra_ID,OldFacts,[P::ProbFact|OldFacts],Body_Vars) :-
Atom =.. [Functor|AllArguments],
append(AllArguments,Body_Vars,NewAllArguments),
length(AllArguments,Arity),
atomic_concat([mvs_fact_,Functor,'_',Arity,'_',Extra_ID],NewAtom),
ProbFact =.. [NewAtom|AllArguments].
ProbFact =.. [NewAtom|NewAllArguments].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
convert_b((X;Y),OldBody,Body,ExtraID,OldBodies,Bodies) :-
convert_b(X,OldBody,NewBody,ExtraID,OldBodies,NewBodies),
convert_b(Y,NewBody,Body,ExtraID,NewBodies,Bodies).
convert_b(_::Atom,OldBody,NewBody,Extra_ID,OldBodies,[(Atom:-ThisBody)|OldBodies]) :-
convert_b((X;Y),OldBody,Body,ExtraID,OldBodies,Bodies,Body_Vars) :-
convert_b(X,OldBody,NewBody,ExtraID,OldBodies,NewBodies,Body_Vars),
convert_b(Y,NewBody,Body,ExtraID,NewBodies,Bodies,Body_Vars).
convert_b(_::Atom,OldBody,NewBody,Extra_ID,OldBodies,[(Atom:-ThisBody)|OldBodies],Body_Vars) :-
Atom =.. [Functor|AllArguments],
append(AllArguments,Body_Vars,NewAllArguments),
length(AllArguments,Arity),
atomic_concat([mvs_fact_,Functor,'_',Arity,'_',Extra_ID],NewFunctor),
ProbFact =.. [NewFunctor|AllArguments],
ProbFact =.. [NewFunctor|NewAllArguments],
tuple_append(OldBody,ProbFact,ThisBody),
tuple_append(OldBody,problog_not(ProbFact),NewBody).

4
packages/ProbLog/problog/extlists.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/flags.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/gflags.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/hash_table.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/intervals.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/logger.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-10-11 14:14:11 +0200 (Mon, 11 Oct 2010) $
% $Revision: 4892 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/mc_DNF_sampling.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

193
packages/ProbLog/problog/nestedtries.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-11-03 19:13:53 +0100 (Wed, 03 Nov 2010) $
% $Revision: 4986 $
% $Date: 2010-12-16 13:33:43 +0100 (Thu, 16 Dec 2010) $
% $Revision: 5156 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog
@ -211,9 +211,25 @@
:- module(nestedtries, [nested_trie_to_depth_breadth_trie/4]).
:- use_module(library(ordsets), [list_to_ord_set/2, ord_subset/2]). % this two might be better to do a custom fast implementation
:- use_module(library(lists), [memberchk/2, delete/3]).
:- use_module(library(tries), [trie_to_depth_breadth_trie/6, trie_get_depth_breadth_reduction_entry/1, trie_dup/2, trie_close/1, trie_open/1, trie_replace_nested_trie/3, trie_remove_entry/1, trie_get_entry/2, trie_put_entry/3, trie_traverse/2]).
:- use_module(library(ordsets), [list_to_ord_set/2,
ord_subset/2,
ord_union/3,
ord_intersection/3]).
:- use_module(library(lists), [append/3,
memberchk/2,
delete/3]).
:- use_module(library(tries), [trie_to_depth_breadth_trie/6,
trie_get_depth_breadth_reduction_entry/1,
trie_dup/2,
trie_close/1,
trie_open/1,
trie_replace_nested_trie/3,
trie_remove_entry/1,
trie_get_entry/2,
trie_put_entry/3,
trie_traverse/2,
trie_traverse_mode/1,
trie_usage/4]).
:- use_module(flags, [problog_define_flag/5, problog_flag/2]).
@ -221,18 +237,21 @@
:- yap_flag(unknown,error).
:- initialization((
% problog_define_flag(subset_check, problog_flag_validate_boolean, 'perform subset check in nested tries', true, nested_tries),
problog_define_flag(loop_refine_ancs, problog_flag_validate_boolean, 'refine ancestors if no loop exists', true, nested_tries)
% problog_define_flag(trie_preprocess, problog_flag_validate_boolean, 'perform a preprocess step to nested tries', false, nested_tries),
% problog_define_flag(refine_anclst, problog_flag_validate_boolean, 'refine the ancestor list with their childs', false, nested_tries),
% problog_define_flag(anclst_represent,problog_flag_validate_in_list([list, integer]), 'represent the ancestor list', list, nested_tries)
problog_define_flag(subset_check, problog_flag_validate_boolean, 'perform subset check in nested tries', true, nested_tries),
problog_define_flag(loop_refine_ancs, problog_flag_validate_boolean, 'refine ancestors if no loop exists', true, nested_tries),
problog_define_flag(trie_preprocess, problog_flag_validate_boolean, 'perform a preprocess step to nested tries', false, nested_tries),
problog_define_flag(refine_anclst, problog_flag_validate_boolean, 'refine the ancestor list with their childs', false, nested_tries),
problog_define_flag(anclst_represent,problog_flag_validate_in_list([list, integer]), 'represent the ancestor list', list, nested_tries)
)).
trie_replace_entry(_Trie, Entry, _E, false):-
!, trie_remove_entry(Entry).
trie_replace_entry(_Trie, Entry, E, false):-
trie_get_entry(Entry, Proof),
memberchk(E, Proof), !,
trie_remove_entry(Entry).
trie_replace_entry(Trie, Entry, E, true):-
!, trie_get_entry(Entry, Proof),
trie_get_entry(Entry, Proof),
memberchk(E, Proof), !,
delete(Proof, E, NewProof),
(NewProof == [] ->
trie_delete(Trie),
@ -275,6 +294,12 @@ is_label(Label, ID):-
Label = not(NestedLabel),
is_label(NestedLabel, ID).
simplify(not(false), true):- !.
simplify(not(true), false):- !.
simplify(not(not(A)), B):-
!, simplify(A, B).
simplify(A, A).
% Ancestor related stuff
initialise_ancestors(0):-
@ -289,6 +314,13 @@ add_to_ancestors(ID, Ancestors, NewAncestors):-
is_list(Ancestors),
list_to_ord_set([ID|Ancestors], NewAncestors).
ancestors_union(Ancestors1, Ancestors2, NewAncestors):-
integer(Ancestors1), !,
NewAncestors is Ancestors1 \/ Ancestors2.
ancestors_union(Ancestors1, Ancestors2, NewAncestors):-
is_list(Ancestors1),
ord_union(Ancestors1, Ancestors2, NewAncestors).
ancestor_subset_check(SubAncestors, Ancestors):-
integer(SubAncestors), !,
SubAncestors is Ancestors /\ SubAncestors.
@ -302,17 +334,61 @@ ancestor_loop_refine(Loop, Ancestors, []):-
var(Loop), is_list(Ancestors), !.
ancestor_loop_refine(true, Ancestors, Ancestors).
ancestor_child_refine(true, Ancestors, Childs, NewAncestors):-
integer(Ancestors), !,
NewAncestors is Ancestors /\ Childs.
ancestor_child_refine(true, Ancestors, Childs, NewAncestors):-
is_list(Ancestors), !,
ord_intersection(Ancestors, Childs, NewAncestors).
ancestor_child_refine(false, Ancestors, _, Ancestors).
% Cycle check related stuff
% missing synonym check
cycle_check(ID, Ancestors):-
get_negated_synonym_id(ID, SynID),
cycle_check_intern(SynID, Ancestors).
cycle_check_intern(ID, Ancestors):-
integer(Ancestors), !,
Bit is 1 << (ID - 1),
Bit is Bit /\ Ancestors.
cycle_check(ID, Ancestors):-
cycle_check_intern(ID, Ancestors):-
is_list(Ancestors),
memberchk(ID, Ancestors).
get_negated_synonym_id(ID, ID).
get_negated_synonym_id(ID, NegID):-
tabling:has_synonyms,
recorded(problog_table, store(Pred, ID, _, _, _), _),
Pred =.. [Name0|Args],
atomic_concat(problog_, Name1, Name0),
atomic_concat(Name, '_original', Name1),
get_negated_name(Name, NotName1),
atomic_concat([problog_, NotName1, '_original'], NotName),
NegPred =.. [NotName|Args],
recorded(problog_table, store(NegPred, NegID, _, _, _), _).
get_negated_name(Name, NotName1):-
recorded(problog_table_synonyms, negated(Name, NotName1), _), !.
get_negated_name(Name, NotName1):-
recorded(problog_table_synonyms, negated(NotName1, Name), _).
trie_dup_reverse(Trie, DupTrie):-
trie_open(DupTrie),
trie_traverse_mode(backward),
trie_dup_rev(Trie, DupTrie),
trie_traverse_mode(forward).
trie_dup_rev(Trie, DupTrie):-
\+ trie_usage(Trie, 0, 0, 0),
trie_traverse(Trie, Entry),
trie_get_entry(Entry, Term),
trie_put_entry(DupTrie, Term, _),
fail.
trie_dup_rev(_, _).
preprocess(Index, DepthBreadthTrie, OptimizationLevel, StartCount, FinalEndCount):-
problog:problog_chktabled(Index, Trie), !,
trie_dup(Trie, CopyTrie),
@ -332,7 +408,7 @@ make_nested_trie_base_cases(Trie, t(ID), DepthBreadthTrie, OptimizationLevel, St
make_nested_trie_base_cases(Trie, t(ID), DepthBreadthTrie, OptimizationLevel, EndCount, FinalEndCount, NewAncestors)
;
FinalEndCount = EndCount,
get_set_trie(ID, Label, Ancestors)
set_trie(ID, Label, Ancestors)
).
nested_trie_to_depth_breadth_trie(Trie, DepthBreadthTrie, FinalLabel, OptimizationLevel):-
@ -344,80 +420,69 @@ nested_trie_to_depth_breadth_trie(Trie, DepthBreadthTrie, FinalLabel, Optimizati
StartCount = 0
),
initialise_ancestors(Ancestors),
% initialise_ancestors(Childs),
(problog_flag(loop_refine_ancs, true) ->
trie_2_dbtrie_init(Trie, DepthBreadthTrie, OptimizationLevel, StartCount, _, Ancestors, FinalLabel, _)
trie_2_dbtrie_init(Trie, DepthBreadthTrie, OptimizationLevel, StartCount, _, Ancestors, FinalLabel, _, _Childs)
;
trie_2_dbtrie_init(Trie, DepthBreadthTrie, OptimizationLevel, StartCount, _, Ancestors, FinalLabel, true)
trie_2_dbtrie_init(Trie, DepthBreadthTrie, OptimizationLevel, StartCount, _, Ancestors, FinalLabel, true, _Childs)
),
eraseall(problog_trie_table).
trie_2_dbtrie_init(ID, DepthBreadthTrie, OptimizationLevel, StartCount, EndCount, Ancestors, Label, ContainLoop):-
trie_2_dbtrie_init(ID, DepthBreadthTrie, OptimizationLevel, StartCount, EndCount, Ancestors, Label, ContainLoop, FinalChilds):-
initialise_ancestors(Childs),
get_trie_pointer(ID, Trie),
trie_dup(Trie, CopyTrie),
trie_2_dbtrie_intern(CopyTrie, DepthBreadthTrie, OptimizationLevel, StartCount, EndCount, Ancestors, Label, ContainLoop),
trie_dup_reverse(Trie, CopyTrie),
trie_2_dbtrie_intern(CopyTrie, DepthBreadthTrie, OptimizationLevel, StartCount, EndCount, Ancestors, Label, ContainLoop, Childs, FinalChilds),
trie_close(CopyTrie).
trie_2_dbtrie_intern(Trie, DepthBreadthTrie, OptimizationLevel, StartCount, FinalEndCount, Ancestors, TrieLabel, ContainLoop):-
trie_2_dbtrie_intern(Trie, DepthBreadthTrie, OptimizationLevel, StartCount, FinalEndCount, Ancestors, TrieLabel, ContainLoop, Childs, FinalChilds):-
trie_to_depth_breadth_trie(Trie, DepthBreadthTrie, Label, OptimizationLevel, StartCount, EndCount),
(is_trie(Label, ID) -> % Label might have issues with negation
(is_trie(Label, ID) ->
problog_flag(refine_anclst, ChildRefineAncestors),
trie_get_depth_breadth_reduction_entry(NestedEntry),
% check if Trie introduces a loop
(cycle_check(ID, Ancestors) ->
ContainLoop = true,
NewLabel = false,
NewEndCount = EndCount,
initialise_ancestors(GrandChilds)
; get_trie(ID, NewLabel, Ancestors) ->
GrandChilds = Ancestors,
NewEndCount = EndCount
;
% check if Trie is resolved and extract it
(get_set_trie(ID, NewLabel, Ancestors) ->
NewEndCount = EndCount
;
% calculate the nested trie
add_to_ancestors(ID, Ancestors, NewAncestors), % to be able to support 2 representations
trie_2_dbtrie_init(ID, DepthBreadthTrie, OptimizationLevel, EndCount, NewEndCount, NewAncestors, NewLabel, NewContainLoop),
ancestor_loop_refine(NewContainLoop, Ancestors, RefinedAncestors),
get_set_trie(ID, NewLabel, RefinedAncestors),
ContainLoop = NewContainLoop
)
add_to_ancestors(ID, Ancestors, NewAncestors),
trie_2_dbtrie_init(ID, DepthBreadthTrie, OptimizationLevel, EndCount, NewEndCount, NewAncestors, DerefLabel, NewContainLoop, GrandChilds),
ancestor_loop_refine(NewContainLoop, Ancestors, RefinedAncestors1),
ancestor_child_refine(ChildRefineAncestors, RefinedAncestors1, GrandChilds, RefinedAncestors),
simplify(DerefLabel, NewLabel),
set_trie(ID, NewLabel, RefinedAncestors),
ContainLoop = NewContainLoop
),
trie_replace_entry(Trie, NestedEntry, t(ID), NewLabel), % should be careful to verify that it works also with not(t(ID))
trie_2_dbtrie_intern(Trie, DepthBreadthTrie, OptimizationLevel, NewEndCount, FinalEndCount, Ancestors, TrieLabel, ContainLoop)
trie_replace_entry(Trie, NestedEntry, t(ID), NewLabel),
(ChildRefineAncestors ->
add_to_ancestors(ID, Childs, NewChilds1),
ancestors_union(NewChilds1, GrandChilds, NewChilds)
;
NewChilds = Childs
),
trie_2_dbtrie_intern(Trie, DepthBreadthTrie, OptimizationLevel, NewEndCount, FinalEndCount, Ancestors, TrieLabel, ContainLoop, NewChilds, FinalChilds)
;
% else we can terminate and return
FinalEndCount = EndCount,
TrieLabel = Label
TrieLabel = Label,
FinalChilds = Childs
).
% predicate to check/remember resolved tries
% no refiment of ancestor list included
get_trie_pointer(ID, Trie):-
problog:problog_chktabled(ID, Trie), !.
get_trie_pointer(Trie, Trie).
get_set_trie(Trie, Label, Ancestors):-
get_trie(Trie, Label, Ancestors):-
problog_flag(subset_check, true), !,
recorded(problog_trie_table, store(Trie, StoredAncestors, Label), _),
(problog_flag(subset_check, true) ->
ancestor_subset_check(StoredAncestors, Ancestors)
;
StoredAncestors == Ancestors
), !.
get_set_trie(Trie, Label, Ancestors):-
ground(Label),
ancestor_subset_check(StoredAncestors, Ancestors).
get_trie(Trie, Label, Ancestors):-
recorded(problog_trie_table, store(Trie, StoredAncestors, Label), _),
StoredAncestors == Ancestors.
set_trie(Trie, Label, Ancestors):-
recordz(problog_trie_table, store(Trie, Ancestors, Label), _).
% chk_negated([H|T], ID):-
% simplify(H, not(t(ID))), !.
% chk_negated([_|T], ID):-
% chk_negated(T, ID).
/*
chk_negated([], ID, ID).
chk_negated([H|T], ID, not(ID)):-
simplify(H, not(t(ID))), !.
chk_negated([H|T], ID, ID):-
simplify(H, t(ID)), !.
chk_negated([_|T], ID, FID):-
chk_negated(T, ID, FID).*/

4
packages/ProbLog/problog/os.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-11-29 10:58:04 +0100 (Mon, 29 Nov 2010) $
% $Revision: 5029 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/print.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-10-06 12:56:13 +0200 (Wed, 06 Oct 2010) $
% $Revision: 4877 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/print_learning.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

41
packages/ProbLog/problog/ptree.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-12-02 14:35:05 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5041 $
% $Date: 2010-12-16 13:33:43 +0100 (Thu, 16 Dec 2010) $
% $Revision: 5156 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog
@ -282,12 +282,7 @@
problog_define_flag(use_naive_trie, problog_flag_validate_boolean, 'use the naive algorithm to generate bdd scripts', false),
problog_define_flag(use_old_trie, problog_flag_validate_boolean, 'use the old trie 2 trie transformation no nested', true),
problog_define_flag(use_dec_trie, problog_flag_validate_boolean, 'use the decomposition method', false),
problog_define_flag(subset_check, problog_flag_validate_boolean, 'perform subset check in nested tries', true),
problog_define_flag(deref_terms, problog_flag_validate_boolean, 'deref BDD terms after last use', false),
problog_define_flag(trie_preprocess, problog_flag_validate_boolean, 'perform a preprocess step to nested tries', false),
problog_define_flag(refine_anclst, problog_flag_validate_boolean, 'refine the ancestor list with their childs', false),
problog_define_flag(anclst_represent,problog_flag_validate_in_list([list, integer]), 'represent the ancestor list', list)
problog_define_flag(deref_terms, problog_flag_validate_boolean, 'deref BDD terms after last use', false)
)).
@ -1252,6 +1247,8 @@ add_to_vars(V):-
variables_in_dbtrie(Trie, []):-
empty_ptree(Trie), !.
variables_in_dbtrie(Trie, []):-
trie_check_entry(Trie, [true], _R), !.
variables_in_dbtrie(Trie, L):-
all(V, variable_in_dbtrie(Trie,V), L).
@ -1339,10 +1336,11 @@ is_state(false).
nested_trie_to_bdd_trie(A, B, OutputFile, OptimizationLevel, FileParam):-
% trie_nested_to_depth_breadth_trie(A, B, LL, OptimizationLevel, problog:problog_chktabled),
nested_trie_to_depth_breadth_trie(A, B, LL, OptimizationLevel),
(is_label(LL) ->
simplify(LL, FLL),
(is_label(FLL) ->
retractall(deref(_,_)),
(problog_flag(deref_terms, true) ->
asserta(deref(LL,no)),
asserta(deref(FLL,no)),
mark_for_deref(B),
V = 3
;
@ -1358,7 +1356,7 @@ nested_trie_to_bdd_trie(A, B, OutputFile, OptimizationLevel, FileParam):-
write('@BDD'), write(V), nl,
write(VarCNT), nl,
write(0), nl,
(LL = not(NegL)->
(FLL = not(NegL)->
atomic_concat('L', NegStep, NegL),
number_atom(NegStepN, NegStep),
InterStep is NegStepN + 1,
@ -1368,19 +1366,18 @@ nested_trie_to_bdd_trie(A, B, OutputFile, OptimizationLevel, FileParam):-
write(FL), write(' = ~'), write(NegL), nl,
write(FL), nl
;
atomic_concat('L', InterStep, LL),
atomic_concat('L', InterStep, FLL),
write(InterStep), nl,
trie_write(B, LL),
write(LL), nl
trie_write(B, FLL),
write(FLL), nl
),
told
;
(is_state(LL) ->
(is_state(FLL) ->
Edges = []
;
Edges = [LL]
Edges = [FLL]
),
writeln(Edges),
tell(FileParam),
simplify_list(Edges, SEdges),
bdd_vars_script(SEdges),
@ -1390,12 +1387,11 @@ nested_trie_to_bdd_trie(A, B, OutputFile, OptimizationLevel, FileParam):-
write(1), nl,
write(0), nl,
write(1), nl,
(LL = not(_) ->
(FLL = not(_) ->
write('L1 = ~')
;
write('L1 = ')
),
simplify(LL, FLL),
get_var_name(FLL, NLL),
write(NLL),nl,
write('L1'), nl,
@ -1830,6 +1826,7 @@ ptree_decomposition(Trie, BDDFileName, VarFileName) :-
tmpnam(TmpFile1),
nb_setval(next_inter_step, 1),
variables_in_dbtrie(Trie, T),
length(T, VarCnt),
tell(VarFileName),
bdd_vars_script(T),
@ -1860,6 +1857,9 @@ get_next_inter_step(I):-
decompose_trie(Trie, _, false):-
empty_ptree(Trie), !.
decompose_trie(Trie, _, 'TRUE'):-
trie_check_entry(Trie, [true], _R),!.
decompose_trie(Trie, [H|[]], Var):-
trie_usage(Trie, 1, _, _),
get_var_name(H, VarA),
@ -1871,9 +1871,6 @@ decompose_trie(Trie, [H|[]], Var):-
),
!.
decompose_trie(Trie, _, 'TRUE'):-
trie_check_entry(Trie, [true], _R),!.
decompose_trie(Trie, [H|_T], L3):-
trie_open(TrieWith),
trie_open(TrieWithNeg),

4
packages/ProbLog/problog/sampling.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

38
packages/ProbLog/problog/tabling.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-11-09 15:09:33 +0100 (Tue, 09 Nov 2010) $
% $Revision: 4992 $
% $Date: 2010-12-13 16:29:18 +0100 (Mon, 13 Dec 2010) $
% $Revision: 5122 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog
@ -298,12 +298,6 @@ problog_table_next_index(Index):-
NIndex is Index + 1,
nb_setval(problog_tabling_next_index, NIndex).
makeargs(0, []):-!.
makeargs(N, [_Arg|L]):-
N > 0,
NN is N - 1,
makeargs(NN, L).
problog_table(M:P) :- !,
problog_table(P, M).
problog_table(P) :-
@ -311,21 +305,21 @@ problog_table(P) :-
problog_table(P, M).
problog_table(M:P, _) :-
problog_table(P, M).
problog_table(P, M).
problog_table((P1, P2), M) :-
problog_table(P1, M),
problog_table(P2, M).
problog_table(P1, M),
problog_table(P2, M).
problog_table(Name/Arity, Module) :-
makeargs(Arity, Args),
Head =.. [Name|Args],
\+ predicate_property(Module:Head, dynamic), !,
throw(error('problog_table: Problog tabling currently requires the predicate to be declared dynamic and compiles it to static.')).
length(Args,Arity),
Head =.. [Name|Args],
\+ predicate_property(Module:Head, dynamic), !,
throw(error('problog_table: Problog tabling currently requires the predicate to be declared dynamic and compiles it to static.')).
problog_table(Name/Arity, Module) :-
makeargs(Arity, Args),
Head =.. [Name|Args],
atom_concat(['problog_', Name, '_original'], OriginalName),
atom_concat(['problog_', Name, '_mctabled'], MCName),
atom_concat(['problog_', Name, '_tabled'], ExactName),
length(Args,Arity),
Head =.. [Name|Args],
atom_concat(['problog_', Name, '_original'], OriginalName),
atom_concat(['problog_', Name, '_mctabled'], MCName),
atom_concat(['problog_', Name, '_tabled'], ExactName),
% Monte carlo tabling
catch((table(Module:MCName/Arity),
@ -413,8 +407,8 @@ problog_table(Name/Arity, Module) :-
erase(Ref),
(empty_ptree(HashTrie) ->
recordz(problog_table, store(OriginalPred, Hash, HashTrie, SuspTrie, fail), _NRef),
delete_ptree(SuspTrie),
fail % no justification exists
delete_ptree(SuspTrie) %,
%fail % no justification exists
;
recordz(problog_table, store(OriginalPred, Hash, HashTrie, SuspTrie, true), _NRef),
merge_ptree(HashTrie, SuspTrie),

4
packages/ProbLog/problog/timer.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-10-15 17:09:55 +0200 (Fri, 15 Oct 2010) $
% $Revision: 4939 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

81
packages/ProbLog/problog/utils.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-12-02 14:35:05 +0100 (Thu, 02 Dec 2010) $
% $Revision: -1 $
% $Date: 2010-12-15 15:52:58 +0100 (Wed, 15 Dec 2010) $
% $Revision: 5144 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog
@ -211,20 +211,21 @@
slice_n/4,
sorted_overlap_test/2,
prefix_bdd_file_with_header/4,
split_list/3]).
split_list/3,
succeeds_n_times/2,
sum_forall/3]).
:- use_module(library(system), [delete_file/1]).
% load swi library, at some point vitor will make swi_expand_file_name/2 a built-in
:- load_foreign_files([libplstream], [], initIO).
% load our own modules
:- use_module(os).
:- meta_predicate succeeds_n_times(0,?), sum_forall(?,:,?).
%========================================================================
%=
%=
%= deletes File, if it doesn't exists, it will succeed silently
%= delete_file_silently(+File)
%========================================================================
delete_file_silently(File) :-
@ -232,9 +233,10 @@ delete_file_silently(File) :-
!.
delete_file_silently(_).
%========================================================================
%=
%=
%= delete all the files in the list silently
%= delete_files_silently(+List)
%========================================================================
delete_files_silently([]).
@ -242,23 +244,25 @@ delete_files_silently([H|T]) :-
delete_file_silently(H),
delete_files_silently(T).
%========================================================================
%=
%=
%= delete all the files matching a certain pattern silently
%= i.e. delete_file_pattern_silently('~/a_path/b_path/','*.txt')
%=
%= delete_file_pattern_silently(+Path,+Pattern)
%========================================================================
delete_file_pattern_silently(Path,Pattern) :-
concat_path_with_filename(Path,Pattern,AbsolutePattern),
swi_expand_file_name(AbsolutePattern,Files),
expand_file_name(AbsolutePattern,Files),
delete_files_silently(Files).
%========================================================================
%= Split a list into the first n elements and the tail
%= +List +Integer -Prefix -Residuum
%= slice_n(+List, +Integer, -Prefix, -Residuum)
%========================================================================
slice_n([],_,[],[]) :-
!.
slice_n([H|T],N,[H|T2],T3) :-
@ -268,9 +272,11 @@ slice_n([H|T],N,[H|T2],T3) :-
slice_n(T,N2,T2,T3).
slice_n(L,0,[],L).
%========================================================================
%= succeeds if the variable V appears exactly once in the term T
%========================================================================
variable_in_term_exactly_once(T,V) :-
term_variables(T,Vars),
var_memberchk_once(Vars,V).
@ -287,6 +293,7 @@ var_memberchk_none([H|T],V) :-
var_memberchk_none(T,V).
var_memberchk_none([],_).
%========================================================================
%= sorted_overlap_test(+L1,+L2)
%= L1 and L2 are ground sorted lists
@ -314,7 +321,7 @@ sorted_overlap_test([_|T1],[H2|T2]) :-
prefix_bdd_file_with_header(BDD_File_Name,VarCount,IntermediateSteps,TmpFile) :-
open(BDD_File_Name,write,H),
% this is the header of the BDD script for problogbdd
format(H, '@BDD1~n~q~n0~n~q~n',[VarCount,IntermediateSteps]),
format(H, '@BDD1~n~w~n0~n~w~n',[VarCount,IntermediateSteps]),
% append the content of the file TmpFile
open(TmpFile,read,H2),
@ -333,12 +340,15 @@ prefix_bdd_file_with_header(BDD_File_Name,VarCount,IntermediateSteps,TmpFile) :-
%========================================================================
%= Split the list L in the two lists L1 and L2 such that
%= append(L1,L2,L) holds.
%=
%= if length of L is even, then L1 and L2 will have the same length
%= if length of L is odd, then L1 will be one element longer than L2
%=
%=
%= split_list(+L,-L1,-L2)
%========================================================================
split_list([],[],[]).
split_list([H|T],L1,L2) :-
length([H|T],Len),
@ -349,4 +359,35 @@ split_list_intern(0,L,[],L).
split_list_intern(N,[H|T],[H|T1],L) :-
N>0,
N2 is N-1,
split_list_intern(N2,T,T1,L).
split_list_intern(N2,T,T1,L).
%========================================================================
%= Counts how often Goal succeeds
%= (taken from the YAP manual)
%========================================================================
succeeds_n_times(Goal, Times) :-
Counter = counter(0),
( Goal,
arg(1, Counter, N0),
N is N0 + 1,
nb_setarg(1, Counter, N),
fail
; arg(1, Counter, Times)
).
%========================================================================
%=
%=
%========================================================================
sum_forall(X,Goal, Sum) :-
Temp = sum(0),
( Goal,
arg(1, Temp, Sum0),
Sum is Sum0+X,
nb_setarg(1, Temp, Sum),
fail
; arg(1, Temp, Sum)
).

55
packages/ProbLog/problog/utils_learning.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-12-02 14:35:05 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5041 $
% $Date: 2010-12-14 20:30:07 +0100 (Tue, 14 Dec 2010) $
% $Revision: 5134 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog
@ -209,7 +209,10 @@
create_known_values_file_name/2,
create_bdd_file_name/3,
create_bdd_input_file_name/2,
create_bdd_output_file_name/4]).
create_bdd_output_file_name/4,
create_factprobs_file_name/2,
create_test_predictions_file_name/2,
create_training_predictions_file_name/2]).
@ -249,10 +252,7 @@ empty_output_directory :-
delete_file_pattern_silently(Path,'values_*'),
delete_file_pattern_silently(Path,'factprobs_*'),
delete_file_pattern_silently(Path,'input_*'),
delete_file_pattern_silently(Path,'trainpredictions_*'),
delete_file_pattern_silently(Path,'testpredictions_*'),
delete_file_pattern_silently(Path,'predictions_*').
empty_output_directory :-
throw(error(problog_flag_does_not_exist(output_directory))).
@ -311,4 +311,47 @@ create_bdd_input_file_name(Iteration,Absolute_File_Name) :-
atomic_concat(['input_',Iteration,'.txt'],File_Name),
concat_path_with_filename(Path,File_Name,Absolute_File_Name).
create_bdd_input_file_name(_,_) :-
throw(error(problog_flag_does_not_exist(output_directory))).
%========================================================================
%=
%=
%========================================================================
create_factprobs_file_name(Iteration,Absolute_File_Name) :-
problog_flag(output_directory,Path),
!,
atomic_concat(['factprobs_',Iteration,'.pl'],File_Name),
concat_path_with_filename(Path,File_Name,Absolute_File_Name).
create_factprobs_file_name(_,_) :-
throw(error(problog_flag_does_not_exist(output_directory))).
%========================================================================
%=
%=
%========================================================================
create_test_predictions_file_name(Iteration,Absolute_File_Name) :-
problog_flag(output_directory,Path),
!,
atomic_concat(['predictions_test_',Iteration,'.pl'],File_Name),
concat_path_with_filename(Path,File_Name,Absolute_File_Name).
create_test_predictions_file_name(_,_) :-
throw(error(problog_flag_does_not_exist(output_directory))).
%========================================================================
%=
%=
%========================================================================
create_training_predictions_file_name(Iteration,Absolute_File_Name) :-
problog_flag(output_directory,Path),
!,
atomic_concat(['predictions_training_',Iteration,'.pl'],File_Name),
concat_path_with_filename(Path,File_Name,Absolute_File_Name).
create_training_predictions_file_name(_,_) :-
throw(error(problog_flag_does_not_exist(output_directory))).

4
packages/ProbLog/problog/variable_elimination.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/variables.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-09-28 21:04:43 +0200 (Tue, 28 Sep 2010) $
% $Revision: 4838 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

4
packages/ProbLog/problog/version_control.yap
View File

@ -2,8 +2,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Date: 2010-10-05 18:15:57 +0200 (Tue, 05 Oct 2010) $
% $Revision: 4876 $
% $Date: 2010-12-02 15:20:15 +0100 (Thu, 02 Dec 2010) $
% $Revision: 5043 $
%
% This file is part of ProbLog
% http://dtai.cs.kuleuven.be/problog

831
packages/ProbLog/problog_learning.yap
View File

File diff suppressed because it is too large Load Diff

6
packages/ProbLog/simplecudd/problogmath.c
View File

@ -7,8 +7,8 @@
* *
* Author: Bernd Gutmann *
* File: problogmath.c *
* $Date:: 2010-10-06 13:20:59 +0200 (Wed, 06 Oct 2010) $ *
* $Revision:: 4880 $ *
* $Date:: 2010-12-17 12:21:58 +0100 (Fri, 17 Dec 2010) $ *
* $Revision:: 5159 $ *
* *
********************************************************************************
* *
@ -187,7 +187,7 @@
\******************************************************************************/
#include "problogmath.h"
#include "general.h"
double sigmoid(double x, double slope) {
return 1.0 / (1.0 + exp(-x * slope));

6
packages/ProbLog/simplecudd/problogmath.h
View File

@ -7,8 +7,8 @@
* *
* Author: Bernd Gutmann *
* File: problogmath.h *
* $Date:: 2010-10-06 13:20:59 +0200 (Wed, 06 Oct 2010) $ *
* $Revision:: 4880 $ *
* $Date:: 2010-12-17 12:21:58 +0100 (Fri, 17 Dec 2010) $ *
* $Revision:: 5159 $ *
* *
********************************************************************************
* *
@ -212,4 +212,6 @@ double cumulative_normal_upper(double high, double mu, double sigma);
double cumulative_normal_upper_dsigma(double high,double mu,double sigma);
double cumulative_normal_upper_dmu(double high,double mu,double sigma);
double normal(double x, double mu,double sigma);
density_integral parse_density_integral_string(char *input, char *variablename);

6
packages/ProbLog/simplecudd/simplecudd.c
View File

@ -7,8 +7,8 @@
* *
* Author: Theofrastos Mantadelis *
* File: simplecudd.c *
* $Date:: 2010-10-06 13:20:59 +0200 (Wed, 06 Oct 2010) $ *
* $Revision:: 4880 $ *
* $Date:: 2010-12-17 12:21:58 +0100 (Fri, 17 Dec 2010) $ *
* $Revision:: 5159 $ *
* *
********************************************************************************
* *
@ -1688,7 +1688,7 @@ int GetParam(char *inputline, int iParam) {
void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd) {
char buf, *inputline;
int icur, maxlinesize, iline, index, iloop, iQsize, i, inQ, iRoot; //ivalue,
int icur, maxlinesize, iline, index, iloop, iQsize, i, iRoot; //ivalue,inQ,
// double dvalue;
DdNode **Q, **Q2, *h_node, *l_node, *curnode;
hisqueue *his;

12
pl/signals.yap
View File

@ -191,11 +191,21 @@
Run \= off,
'$zip'(-1, G, Mod), !,
'$signal_creep',
'$execute_nonstop'(G,Mod).
'$execute_goal'(G, Mod).
'$start_creep'([Mod|G]) :-
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, no).
'$execute_goal'(G, Mod) :-
(
'$is_metapredicate'(G, Mod)
->
'$meta_call'(G,Mod)
;
'$execute_nonstop'(G,Mod)
).
'$signal_do'(Sig, Goal) :-
recorded('$signal_handler', action(Sig,Goal), _), !.
'$signal_do'(Sig, Goal) :-