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

bug fixes for YapTab support

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1259 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc 2005-03-04 20:30:14 +00:00
parent b729ef2709
commit 4c972ca825
26 changed files with 372 additions and 525 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
C/absmi.c
View File

@ -10,8 +10,12 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-03-01 22:25:07 $,$Author: vsc $ * * Last rev: $Date: 2005-03-04 20:29:55 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.158 2005/03/01 22:25:07 vsc
* fix pruning bug
* make DL_MALLOC less enthusiastic about walking through buckets.
*
* Revision 1.157 2005/02/08 18:04:17 vsc * Revision 1.157 2005/02/08 18:04:17 vsc
* library_directory may not be deterministic (usually it isn't). * library_directory may not be deterministic (usually it isn't).
* *
@ -571,7 +575,7 @@ Yap_absmi(int inp)
restore_yaam_regs(PREG->u.ld.d); restore_yaam_regs(PREG->u.ld.d);
restore_at_least_one_arg(PREG->u.ld.s); restore_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -590,7 +594,7 @@ Yap_absmi(int inp)
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->u.ld.s); restore_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -602,7 +606,7 @@ Yap_absmi(int inp)
/* After trust, cut should be pointing at the new top /* After trust, cut should be pointing at the new top
* choicepoint */ * choicepoint */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -657,7 +661,7 @@ Yap_absmi(int inp)
restore_yaam_regs(PREG->u.ld.d); restore_yaam_regs(PREG->u.ld.d);
restore_args(PREG->u.ld.s); restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -676,7 +680,7 @@ Yap_absmi(int inp)
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_args(PREG->u.ld.s); restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -688,7 +692,7 @@ Yap_absmi(int inp)
/* After trust, cut should be pointing at the new top /* After trust, cut should be pointing at the new top
* choicepoint */ * choicepoint */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -802,7 +806,7 @@ Yap_absmi(int inp)
restore_yaam_regs(PREG->u.ld.d); restore_yaam_regs(PREG->u.ld.d);
restore_args(PREG->u.ld.s); restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -821,7 +825,7 @@ Yap_absmi(int inp)
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_args(PREG->u.ld.s); restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -833,7 +837,7 @@ Yap_absmi(int inp)
/* After trust, cut should be pointing at the new top /* After trust, cut should be pointing at the new top
* choicepoint */ * choicepoint */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -884,7 +888,7 @@ Yap_absmi(int inp)
CACHE_Y(B); CACHE_Y(B);
restore_yaam_regs(PREG->u.ld.d); restore_yaam_regs(PREG->u.ld.d);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -902,7 +906,7 @@ Yap_absmi(int inp)
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -912,7 +916,7 @@ Yap_absmi(int inp)
pop_yaam_regs(); pop_yaam_regs();
S_YREG = (CELL *)(B_YREG+1); S_YREG = (CELL *)(B_YREG+1);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -949,7 +953,7 @@ Yap_absmi(int inp)
restore_yaam_regs(PREG->u.ld.d); restore_yaam_regs(PREG->u.ld.d);
ARG1 = B_YREG->cp_a1; ARG1 = B_YREG->cp_a1;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -968,7 +972,7 @@ Yap_absmi(int inp)
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
ARG1 = B_YREG->cp_a1; ARG1 = B_YREG->cp_a1;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -979,7 +983,7 @@ Yap_absmi(int inp)
ARG1 = B_YREG->cp_a1; ARG1 = B_YREG->cp_a1;
S_YREG = &(B_YREG->cp_a2); S_YREG = &(B_YREG->cp_a2);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -1025,7 +1029,7 @@ Yap_absmi(int inp)
ARG1 = B_YREG->cp_a1; ARG1 = B_YREG->cp_a1;
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -1045,7 +1049,7 @@ Yap_absmi(int inp)
ARG1 = B_YREG->cp_a1; ARG1 = B_YREG->cp_a1;
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -1057,7 +1061,7 @@ Yap_absmi(int inp)
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
S_YREG = &(B_YREG->cp_a3); S_YREG = &(B_YREG->cp_a3);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -1107,7 +1111,7 @@ Yap_absmi(int inp)
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -1128,7 +1132,7 @@ Yap_absmi(int inp)
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -1141,7 +1145,7 @@ Yap_absmi(int inp)
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
S_YREG = &(B_YREG->cp_a4); S_YREG = &(B_YREG->cp_a4);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -1194,7 +1198,7 @@ Yap_absmi(int inp)
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
ARG4 = B_YREG->cp_a4; ARG4 = B_YREG->cp_a4;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -1216,7 +1220,7 @@ Yap_absmi(int inp)
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
ARG4 = B_YREG->cp_a4; ARG4 = B_YREG->cp_a4;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -1230,7 +1234,7 @@ Yap_absmi(int inp)
ARG4 = B_YREG->cp_a4; ARG4 = B_YREG->cp_a4;
S_YREG = &(B_YREG->cp_a5); S_YREG = &(B_YREG->cp_a5);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
@ -1658,7 +1662,7 @@ Yap_absmi(int inp)
restore_yaam_regs(PREG); restore_yaam_regs(PREG);
restore_args(PREG->u.ld.s); restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -1722,17 +1726,6 @@ Yap_absmi(int inp)
PREFETCH_OP(PREG); PREFETCH_OP(PREG);
failloop: failloop:
if (pt0 == S_TR) { if (pt0 == S_TR) {
#ifdef FROZEN_STACKS /* TRAIL */
#ifdef SBA
if (pt0 < TR_FZ || pt0 > (tr_fr_ptr)Yap_TrailTop)
#else
if (pt0 < TR_FZ)
#endif /* SBA */
{
TR = TR_FZ;
TRAIL_LINK(pt0);
}
#endif /* FROZEN_STACKS */
SP = SP0; SP = SP0;
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) { if (Yap_do_low_level_trace) {
@ -1837,6 +1830,17 @@ Yap_absmi(int inp)
} }
} }
#endif /* LOW_LEVEL_TRACER */ #endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS
#ifdef SBA
if (pt0 < TR_FZ || pt0 > (tr_fr_ptr)Yap_TrailTop)
#else
if (pt0 < TR_FZ)
#endif /* SBA */
{
TR = TR_FZ;
TRAIL_LINK(pt0);
} else
#endif /* FROZEN_STACKS */
RESTORE_TR(); RESTORE_TR();
GONext(); GONext();
} }
@ -7442,7 +7446,7 @@ Yap_absmi(int inp)
restore_yaam_regs(NEXTOP(PREG, ld)); restore_yaam_regs(NEXTOP(PREG, ld));
restore_at_least_one_arg(PREG->u.ld.s); restore_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -7460,7 +7464,7 @@ Yap_absmi(int inp)
ARG1 = B_YREG->cp_a1; ARG1 = B_YREG->cp_a1;
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -7478,7 +7482,7 @@ Yap_absmi(int inp)
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -7497,7 +7501,7 @@ Yap_absmi(int inp)
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
ARG4 = B_YREG->cp_a4; ARG4 = B_YREG->cp_a4;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -7514,7 +7518,7 @@ Yap_absmi(int inp)
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->u.ld.s); restore_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} }
@ -7524,7 +7528,7 @@ Yap_absmi(int inp)
pop_yaam_regs(); pop_yaam_regs();
pop_at_least_one_arg(PREG->u.ld.s); pop_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }

27
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * comments: allocating space *
* version:$Id: alloc.c,v 1.68 2004-12-05 05:01:22 vsc Exp $ * * version:$Id: alloc.c,v 1.69 2005-03-04 20:30:10 ricroc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -466,7 +466,7 @@ AllocHeap(unsigned int size)
#ifdef YAPOR #ifdef YAPOR
if (HeapTop > Addr(Yap_GlobalBase) - MinHeapGap) { if (HeapTop > Addr(Yap_GlobalBase) - MinHeapGap) {
abort_optyap("No heap left in function AllocHeap"); abort_yapor("No heap left in function AllocHeap");
} }
#else #else
if (HeapTop > HeapLim - MinHeapGap) { if (HeapTop > HeapLim - MinHeapGap) {
@ -815,7 +815,7 @@ static int
ExtendWorkSpace(Int s, int fixed_allocation) ExtendWorkSpace(Int s, int fixed_allocation)
{ {
#ifdef YAPOR #ifdef YAPOR
abort_optyap("function ExtendWorkSpace called"); abort_yapor("function ExtendWorkSpace called");
return(FALSE); return(FALSE);
#else #else
MALLOC_T a; MALLOC_T a;
@ -1266,14 +1266,6 @@ InitHeap(void *heap_addr)
FreeBlocks = NIL; FreeBlocks = NIL;
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
#ifdef USE_HEAP
/* Try to make the system to crash */
BaseAllocArea = NULL;
TopAllocArea = BaseAllocArea;
#else
BaseAllocArea = AllocCodeSpace(OPT_CHUNK_SIZE);
TopAllocArea = BaseAllocArea;
#endif
LOCAL = REMOTE; /* point to the first area */ LOCAL = REMOTE; /* point to the first area */
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */
} }
@ -1289,21 +1281,8 @@ Yap_InitMemory(int Trail, int Heap, int Stack)
{ {
Int pm, sa, ta; Int pm, sa, ta;
#if defined(YAPOR) || defined(TABLING)
{
#ifdef USE_HEAP
int OKHeap = MinHeapSpace+(sizeof(struct global_data) + aux_number_workers*sizeof(struct local_data))/1024;
#else
int OKHeap = MinHeapSpace+(sizeof(struct global_data) + aux_number_workers*sizeof(struct local_data)+OPT_CHUNK_SIZE)/1024;
#endif
if (Heap < OKHeap)
Heap = OKHeap;
}
#else
if (Heap < MinHeapSpace) if (Heap < MinHeapSpace)
Heap = MinHeapSpace; Heap = MinHeapSpace;
#endif /* YAPOR || TABLING */
/* sanity checking for data areas */ /* sanity checking for data areas */
if (Trail < MinTrailSpace) if (Trail < MinTrailSpace)
Trail = MinTrailSpace; Trail = MinTrailSpace;

16
C/amasm.c
View File

@ -11,8 +11,12 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * comments: abstract machine assembler *
* * * *
* Last rev: $Date: 2005-01-28 23:14:34 $ * * Last rev: $Date: 2005-03-04 20:30:10 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.71 2005/01/28 23:14:34 vsc
* move to Yap-4.5.7
* Fix clause size
*
* Revision 1.70 2004/12/28 22:20:35 vsc * Revision 1.70 2004/12/28 22:20:35 vsc
* some extra bug fixes for trail overflows: some cannot be recovered that easily, * some extra bug fixes for trail overflows: some cannot be recovered that easily,
* some can. * some can.
@ -2262,10 +2266,10 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
#define TRYOP(G,P) (IPredArity<5 ? (op_numbers)((int)(P)+(IPredArity*3)) : (G)) #define TRYOP(G,P) (IPredArity<5 ? (op_numbers)((int)(P)+(IPredArity*3)) : (G))
#ifdef YAPOR #ifdef YAPOR
#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, &clinfo, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no) #define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, &clinfo, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no)
#define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cip->cpc->rnd1, code_addr, cip), IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no) #define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cip->cpc->rnd1, cip), IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no)
#else #else
#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, &clinfo, code_p, pass_no) #define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, &clinfo, code_p, pass_no)
#define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cip->cpc->rnd1, code_addr, cip), IPredArity, code_p, pass_no) #define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cip->cpc->rnd1, cip), IPredArity, &clinfo, code_p, pass_no)
#endif /* YAPOR */ #endif /* YAPOR */
static yamop * static yamop *
@ -2407,10 +2411,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
case table_new_answer_op: case table_new_answer_op:
code_p = a_n(_table_new_answer, (int) cip->cpc->rnd2, code_p); code_p = a_n(_table_new_answer, (int) cip->cpc->rnd2, code_p, pass_no);
break; break;
case table_try_single_op: case table_try_single_op:
code_p = a_gl(_table_try_single, code_p, clinfo, code_p, pass_no, cpc); code_p = a_gl(_table_try_single, &clinfo, code_p, pass_no, cip->cpc);
break; break;
#endif /* TABLING */ #endif /* TABLING */
#ifdef TABLING_INNER_CUTS #ifdef TABLING_INNER_CUTS
@ -2706,7 +2710,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
} }
#ifdef TABLING #ifdef TABLING
if (tabled) if (tabled)
code_p = a_gl(_table_trust, &clinfo, code_p, pass_no, cpc); code_p = a_gl(_table_trust, &clinfo, code_p, pass_no, cip->cpc);
else else
#endif #endif
code_p = a_gl(_trust, &clinfo, code_p, pass_no, cip->cpc); code_p = a_gl(_trust, &clinfo, code_p, pass_no, cip->cpc);

8
C/c_interface.c
View File

@ -10,8 +10,12 @@
* File: c_interface.c * * File: c_interface.c *
* comments: c_interface primitives definition * * comments: c_interface primitives definition *
* * * *
* Last rev: $Date: 2005-03-02 18:35:44 $,$Author: vsc $ * * Last rev: $Date: 2005-03-04 20:30:10 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.62 2005/03/02 18:35:44 vsc
* try to make initialisation process more robust
* try to make name more robust (in case Lookup new atom fails)
*
* Revision 1.61 2005/03/01 22:25:08 vsc * Revision 1.61 2005/03/01 22:25:08 vsc
* fix pruning bug * fix pruning bug
* make DL_MALLOC less enthusiastic about walking through buckets. * make DL_MALLOC less enthusiastic about walking through buckets.
@ -1151,7 +1155,7 @@ YAP_Init(YAP_init_args *yap_init)
CurrentModule = USER_MODULE; CurrentModule = USER_MODULE;
P = GETWORK_FIRST_TIME; P = GETWORK_FIRST_TIME;
Yap_exec_absmi(FALSE); Yap_exec_absmi(FALSE);
abort_optyap("abstract machine unexpected exit"); abort_yapor("abstract machine unexpected exit");
} }
#endif /* YAPOR */ #endif /* YAPOR */
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */

11
C/cdmgr.c
View File

@ -11,8 +11,12 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2005-02-25 03:39:44 $,$Author: vsc $ * * Last rev: $Date: 2005-03-04 20:30:11 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.153 2005/02/25 03:39:44 vsc
* fix fixes to undefp
* fix bug where clause mistook cp for ap
*
* Revision 1.152 2005/02/08 18:04:57 vsc * Revision 1.152 2005/02/08 18:04:57 vsc
* library_directory may not be deterministic (usually it isn't). * library_directory may not be deterministic (usually it isn't).
* *
@ -263,7 +267,8 @@ PredForChoicePt(yamop *p_code) {
return NULL; return NULL;
case _table_completion: case _table_completion:
case _table_answer_resolution: case _table_answer_resolution:
return ENV_ToP(gc_B->cp_cp); return NULL; /* ricroc: is this OK? */
/* compile error --> return ENV_ToP(gc_B->cp_cp); */
#endif #endif
case _or_else: case _or_else:
if (p_code == p_code->u.sla.sla_u.l) { if (p_code == p_code->u.sla.sla_u.l) {
@ -1209,7 +1214,7 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
PUT_YAMOP_SEQ(pt); PUT_YAMOP_SEQ(pt);
} }
if (YAMOP_LTT(pt) != 1) if (YAMOP_LTT(pt) != 1)
abort_optyap("YAMOP_LTT error in function add_first_static"); abort_yapor("YAMOP_LTT error in function add_first_static");
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
if (is_tabled(p)) { if (is_tabled(p)) {

19
C/compiler.c
View File

@ -11,8 +11,12 @@
* File: compiler.c * * File: compiler.c *
* comments: Clause compiler * * comments: Clause compiler *
* * * *
* Last rev: $Date: 2005-02-21 16:49:39 $,$Author: vsc $ * * Last rev: $Date: 2005-03-04 20:30:11 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.62 2005/02/21 16:49:39 vsc
* amd64 fixes
* library fixes
*
* Revision 1.61 2005/01/28 23:14:35 vsc * Revision 1.61 2005/01/28 23:14:35 vsc
* move to Yap-4.5.7 * move to Yap-4.5.7
* Fix clause size * Fix clause size
@ -1231,11 +1235,15 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
#endif
} }
return; return;
} }
@ -2944,7 +2952,16 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
/* phase 1 : produce skeleton code and variable information */ /* phase 1 : produce skeleton code and variable information */
c_head(head, &cglobs); c_head(head, &cglobs);
if (cglobs.is_a_fact && !cglobs.vtable) { if (cglobs.is_a_fact && !cglobs.vtable) {
#ifdef TABLING
READ_LOCK(cglobs.cint.CurrentPred->PRWLock);
if (is_tabled(cglobs.cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs.cint.CurrentPred->ArityOfPE, &cglobs.cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs.cint); Yap_emit(procceed_op, Zero, Zero, &cglobs.cint);
#ifdef TABLING
READ_UNLOCK(cglobs.cint.CurrentPred->PRWLock);
#endif
/* ground term, do not need much more work */ /* ground term, do not need much more work */
if (cglobs.cint.BlobsStart != NULL) { if (cglobs.cint.BlobsStart != NULL) {
cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart; cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart;

4
C/grow.c
View File

@ -757,6 +757,10 @@ fix_compiler_instructions(PInstr *pcpc)
case enter_lu_op: case enter_lu_op:
case empty_call_op: case empty_call_op:
case blob_op: case blob_op:
#ifdef TABLING
case table_new_answer_op:
case table_try_single_op:
#endif /* TABLING */
break; break;
} }
if (ncpc != NULL) { if (ncpc != NULL) {

8
C/index.c
View File

@ -11,8 +11,12 @@
* File: index.c * * File: index.c *
* comments: Indexing a Prolog predicate * * comments: Indexing a Prolog predicate *
* * * *
* Last rev: $Date: 2005-03-01 22:25:08 $,$Author: vsc $ * * Last rev: $Date: 2005-03-04 20:30:12 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.118 2005/03/01 22:25:08 vsc
* fix pruning bug
* make DL_MALLOC less enthusiastic about walking through buckets.
*
* Revision 1.117 2005/02/25 00:09:06 vsc * Revision 1.117 2005/02/25 00:09:06 vsc
* fix fix, otherwise I'd remove two choice-points :-(. * fix fix, otherwise I'd remove two choice-points :-(.
* *
@ -3262,7 +3266,7 @@ static UInt
emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, int clleft, UInt nxtlbl) emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, int clleft, UInt nxtlbl)
{ {
#ifdef TABLING #ifdef TABLING
if (ap->PredFlags & TabledPredFlag) { if (cint->CurrentPred->PredFlags & TabledPredFlag) {
/* we have two differences with tabling: /* we have two differences with tabling:
1. we cannot allow straight jumps to clauses, otherwise thetabled 1. we cannot allow straight jumps to clauses, otherwise thetabled
would never get to be created. would never get to be created.

112
C/init.c
View File

@ -1122,79 +1122,6 @@ InitVersion(void)
MkAtomTerm(Yap_LookupAtom(YAP_VERSION))); MkAtomTerm(Yap_LookupAtom(YAP_VERSION)));
} }
#if defined(YAPOR) || defined(TABLING)
static void
InitYapOr(int Heap,
int Stack,
int Trail,
int aux_number_workers,
int aux_scheduler_loop,
int aux_delayed_release_load) {
#ifdef YAPOR
worker_id = 0;
#endif /* YAPOR */
/* starting message */
#ifdef YAPOR
if (aux_number_workers > MAX_WORKERS)
abort_optyap("excessive number of workers");
#ifdef ENV_COPY
INFORMATION_MESSAGE("YapOr: copy model - %d worker%s", aux_number_workers, aux_number_workers == 1 ? "":"s");
#elif ACOW
INFORMATION_MESSAGE("YapOr: acow model - %d worker%s", aux_number_workers, aux_number_workers == 1 ? "":"s");
#else /* SBA */
INFORMATION_MESSAGE("YapOr: sba model - %d worker%s", aux_number_workers, aux_number_workers == 1 ? "":"s");
#endif /* ENV_COPY - ACOW - SBA */
#endif /* YAPOR */
#ifdef TABLING
#ifdef TABLING_BATCHED_SCHEDULING
#ifdef YAPOR
#ifdef ALLOC_BEFORE_CHECK
INFORMATION_MESSAGE("YapTab: batched scheduling (TLWL-ABC)");
#endif
#if defined(TABLE_LOCK_AT_WRITE_LEVEL) && ! defined(ALLOC_BEFORE_CHECK)
INFORMATION_MESSAGE("YapTab: batched scheduling (TLWL)");
#endif
#ifdef TABLE_LOCK_AT_NODE_LEVEL
INFORMATION_MESSAGE("YapTab: batched scheduling (TLNL)");
#endif
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
INFORMATION_MESSAGE("YapTab: batched scheduling (TLEL)");
#endif
#else
INFORMATION_MESSAGE("YapTab: batched scheduling");
#endif /* YAPOR */
#else /* TABLING_LOCAL_SCHEDULING */
#ifdef YAPOR
#ifdef ALLOC_BEFORE_CHECK
INFORMATION_MESSAGE("YapTab: local scheduling (TLWL-ABC)");
#endif
#if defined(TABLE_LOCK_AT_WRITE_LEVEL) && ! defined(ALLOC_BEFORE_CHECK)
INFORMATION_MESSAGE("YapTab: local scheduling (TLWL)");
#endif
#ifdef TABLE_LOCK_AT_NODE_LEVEL
INFORMATION_MESSAGE("YapTab: local scheduling (TLNL)");
#endif
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
INFORMATION_MESSAGE("YapTab: local scheduling (TLEL)");
#endif
#else
INFORMATION_MESSAGE("YapTab: local scheduling");
#endif /* YAPOR */
#endif /* TABLING_SCHEDULING */
#endif /* TABLING */
#ifdef YAPOR
map_memory(Heap, Stack, Trail, aux_number_workers);
#else
Yap_InitMemory (Trail, Heap, Stack);
#endif /* YAPOR */
/* global initializations */
init_global(aux_number_workers, aux_scheduler_loop, aux_delayed_release_load);
init_signals();
}
#endif /* YAPOR || TABLING */
void void
Yap_InitWorkspace(int Heap, Yap_InitWorkspace(int Heap,
@ -1228,18 +1155,35 @@ Yap_InitWorkspace(int Heap,
/* also init memory page size, required by later functions */ /* also init memory page size, required by later functions */
Yap_InitSysbits (); Yap_InitSysbits ();
#if defined(YAPOR) || defined(TABLING) #ifdef TABLING
InitYapOr(Heap, #ifdef TABLING_BATCHED_SCHEDULING
Stack, INFORMATION_MESSAGE("YapTab: batched scheduling");
Trail, #else /* TABLING_LOCAL_SCHEDULING */
aux_number_workers, INFORMATION_MESSAGE("YapTab: local scheduling");
aux_scheduler_loop, #endif /* BATCHED - LOCAL */
aux_delayed_release_load); #endif /* TABLING */
#else /* Yap */
Yap_InitMemory (Trail, Heap, Stack);
#endif /* YAPOR || TABLING */
Yap_InitTime ();
#ifdef YAPOR
worker_id = 0;
if (aux_number_workers > MAX_WORKERS)
abort_yapor("excessive number of workers");
#ifdef ENV_COPY
INFORMATION_MESSAGE("YapOr: copy model with %d worker%s", aux_number_workers, aux_number_workers == 1 ? "":"s");
#elif ACOW
INFORMATION_MESSAGE("YapOr: acow model with %d worker%s", aux_number_workers, aux_number_workers == 1 ? "":"s");
#else /* SBA */
INFORMATION_MESSAGE("YapOr: sba model with %d worker%s", aux_number_workers, aux_number_workers == 1 ? "":"s");
#endif /* ENV_COPY - ACOW - SBA */
map_memory(Heap, Stack, Trail, aux_number_workers);
#else
Yap_InitMemory (Trail, Heap, Stack);
#endif /* YAPOR */
#if defined(YAPOR) || defined(TABLING)
init_global(aux_number_workers, aux_scheduler_loop, aux_delayed_release_load);
#endif /* YAPOR || TABLING */
Yap_InitTime ();
AtomHashTableSize = MaxHash; AtomHashTableSize = MaxHash;
HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash); HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
if (HashChain == NULL) { if (HashChain == NULL) {

26
C/save.c
View File

@ -468,18 +468,9 @@ save_heap(void)
j = Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase); j = Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase);
putout(j); putout(j);
mywrite(splfild, (char *) Yap_HeapBase, j); mywrite(splfild, (char *) Yap_HeapBase, j);
#ifdef USE_HEAP
j = Unsigned(HeapTop) - Unsigned(&HashChain); j = Unsigned(HeapTop) - Unsigned(&HashChain);
putout(j); putout(j);
mywrite(splfild, (char *) &HashChain, j); mywrite(splfild, (char *) &HashChain, j);
#else
j = Unsigned(BaseAllocArea) - Unsigned(&HashChain);
putout(j);
mywrite(splfild, (char *) &HashChain, j);
j = Unsigned(HeapTop) - Unsigned(TopAllocBlockArea);
putout(j);
mywrite(splfild, (char *) TopAllocBlockArea, j);
#endif
#else #else
j = Unsigned(HeapTop) - Unsigned(Yap_HeapBase); j = Unsigned(HeapTop) - Unsigned(Yap_HeapBase);
/* store 10 more cells because of the memory manager */ /* store 10 more cells because of the memory manager */
@ -888,28 +879,11 @@ CopyCode(void)
} }
if (myread(splfild, (char *) Yap_HeapBase, j) < 0) if (myread(splfild, (char *) Yap_HeapBase, j) < 0)
return -1; return -1;
#ifdef USE_HEAP
j = get_cell(); j = get_cell();
if (Yap_ErrorMessage) if (Yap_ErrorMessage)
return -1; return -1;
if (myread(splfild, (char *) &HashChain, j) < 0) if (myread(splfild, (char *) &HashChain, j) < 0)
return -1; return -1;
#else
j = get_cell();
if (Yap_ErrorMessage)
return -1;
if (j != Unsigned(BaseAllocArea) - Unsigned(&HashChain)) {
Yap_ErrorMessage = "Base to Hash does not match saved state";
return -1;
}
if (myread(splfild, (char *) &HashChain, j) < 0)
return -1;
j = get_cell();
if (Yap_ErrorMessage)
return -1;
if (myread(splfild, (char *) TopAllocBlockArea, j) < 0)
return -1;
#endif
#else #else
if (myread(splfild, (char *) Yap_HeapBase, if (myread(splfild, (char *) Yap_HeapBase,
(Unsigned(OldHeapTop) - Unsigned(OldHeapBase))) < 0) (Unsigned(OldHeapTop) - Unsigned(OldHeapBase))) < 0)

3
OPTYap/opt.config.h
View File

@ -10,8 +10,8 @@
#define TG_ANSWER_SLOTS 20 #define TG_ANSWER_SLOTS 20
#define STATISTICS 1
/* /*
#define STATISTICS 1
#define YAPOR_ERRORS 1 #define YAPOR_ERRORS 1
#define TABLING_ERRORS 1 #define TABLING_ERRORS 1
*/ */
@ -43,7 +43,6 @@
#define TIMESTAMP_CHECK 1 #define TIMESTAMP_CHECK 1
#define USE_HEAP 1 /* use heap instead of special areas for memory allocation */

40
OPTYap/opt.init.c
View File

@ -41,14 +41,6 @@ ma_h_inner_struct *ma_h_top;
/* ------------------------------------- **
** Local functions declaration **
** ------------------------------------- */
static void receive_signals(int s);
/* ---------------------- ** /* ---------------------- **
** Local macros ** ** Local macros **
** ---------------------- */ ** ---------------------- */
@ -234,7 +226,7 @@ void init_workers(void) {
if (number_workers > 1) { if (number_workers > 1) {
int son; int son;
son = fork(); son = fork();
if (son == -1) abort_optyap("fork error in function init_workers"); if (son == -1) abort_yapor("fork error in function init_workers");
if (son > 0) { if (son > 0) {
/* I am the father, I must stay here and wait for my children to all die */ /* I am the father, I must stay here and wait for my children to all die */
struct sigaction sigact; struct sigaction sigact;
@ -252,7 +244,7 @@ void init_workers(void) {
for (proc = 1; proc < number_workers; proc++) { for (proc = 1; proc < number_workers; proc++) {
int son; int son;
son = fork(); son = fork();
if (son == -1) abort_optyap("fork error in function init_workers"); if (son == -1) abort_yapor("fork error in function init_workers");
if (son == 0) { if (son == 0) {
/* new worker */ /* new worker */
worker_id = proc; worker_id = proc;
@ -263,32 +255,4 @@ void init_workers(void) {
} }
} }
#endif /* YAPOR */ #endif /* YAPOR */
void init_signals(void) {
return;
signal(SIGQUIT, receive_signals);
signal(SIGTERM, receive_signals);
signal(SIGSEGV, receive_signals);
signal(SIGABRT, receive_signals);
signal(SIGFPE, receive_signals);
signal(SIGHUP, receive_signals);
signal(SIGINT, receive_signals);
signal(SIGTSTP, receive_signals);
return;
}
/* ------------------------- **
** Local functions **
** ------------------------- */
static
void receive_signals(int s) {
abort_optyap("receiving signal number %d", s);
return;
}
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */

47
OPTYap/opt.macros.h
View File

@ -36,39 +36,28 @@ extern int Yap_page_size;
#define ALLOC_BLOCK(BLOCK, SIZE) \ #define ALLOC_BLOCK(BLOCK, SIZE) \
BLOCK = (void *) Yap_AllocAtomSpace(SIZE) BLOCK = malloc(SIZE)
#define FREE_BLOCK(BLOCK) \
free(BLOCK)
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
free(STR)
/*
#define ALLOC_BLOCK(BLOCK, SIZE) \
BLOCK = (void *) Yap_AllocCodeSpace(SIZE)
#define FREE_BLOCK(BLOCK) \ #define FREE_BLOCK(BLOCK) \
Yap_FreeCodeSpace((char *) (BLOCK)) Yap_FreeCodeSpace((char *) (BLOCK))
#define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **ptr; \
ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \
BUCKET_PTR = (void *) ptr; \
for (i = NUM_BUCKETS; i != 0; i--) \
*ptr++ = NULL; \
}
#define FREE_HASH_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR)
#ifdef USE_HEAP
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
STR = (STR_TYPE *)Yap_AllocCodeSpace(sizeof(STR_TYPE))
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
STR = (STR_TYPE *)Yap_AllocCodeSpace(sizeof(STR_TYPE))
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
Yap_FreeCodeSpace((ADDR)(STR))
#else
#define ALLOC_PAGE(PG_HD) \ #define ALLOC_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \ LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \ UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \ UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \ if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
if (TopAllocArea == TopWorkArea) \ ALLOC_BLOCK(PG_HD, Yap_page_size); \
abort_optyap("no more free alloc space (ALLOC_PAGE)"); \
UPDATE_STATS(Pg_str_alloc(GLOBAL_PAGES_void), 1); \ UPDATE_STATS(Pg_str_alloc(GLOBAL_PAGES_void), 1); \
PG_HD = (pg_hd_ptr)TopAllocArea; \
TopAllocArea += Yap_page_size \
} else { \ } else { \
PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \ PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \
Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \ Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \
@ -184,8 +173,16 @@ extern int Yap_page_size;
UNLOCK(Pg_lock(STR_PAGES)); \ UNLOCK(Pg_lock(STR_PAGES)); \
} \ } \
} }
#endif /* USE_HEAP */ */
#define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **ptr; \
ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \
BUCKET_PTR = (void *) ptr; \
for (i = NUM_BUCKETS; i != 0; i--) \
*ptr++ = NULL; \
}
#define FREE_HASH_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR)
#define ALLOC_OR_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_or_fr, struct or_frame) #define ALLOC_OR_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_or_fr, struct or_frame)
#define FREE_OR_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_or_fr, struct or_frame) #define FREE_OR_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_or_fr, struct or_frame)

38
OPTYap/opt.memory.c
View File

@ -60,11 +60,11 @@ int shm_mapid[MAX_WORKERS + 1];
void shm_map_memory(int id, int size, void *shmaddr) { void shm_map_memory(int id, int size, void *shmaddr) {
#define SHMMAX 0x2000000 /* as in <asm/shmparam.h> */ #define SHMMAX 0x2000000 /* as in <asm/shmparam.h> */
if (size > SHMMAX) if (size > SHMMAX)
abort_optyap("maximum size for a shm segment exceeded in function shm_map_memory"); abort_yapor("maximum size for a shm segment exceeded in function shm_map_memory");
if ((shm_mapid[id] = shmget(IPC_PRIVATE, size, SHM_R|SHM_W)) == -1) if ((shm_mapid[id] = shmget(IPC_PRIVATE, size, SHM_R|SHM_W)) == -1)
abort_optyap("shmget error in function shm_map_memory: %s", strerror(errno)); abort_yapor("shmget error in function shm_map_memory: %s", strerror(errno));
if (shmat(shm_mapid[id], shmaddr, 0) == (void *) -1) if (shmat(shm_mapid[id], shmaddr, 0) == (void *) -1)
abort_optyap("shmat error in function shm_map_memory: %s", strerror(errno)); abort_yapor("shmat error in function shm_map_memory: %s", strerror(errno));
return; return;
} }
#else /* MMAP_MEMORY_MAPPING_SCHEME */ #else /* MMAP_MEMORY_MAPPING_SCHEME */
@ -73,18 +73,18 @@ open_mapfile(long TotalArea) {
strcpy(mapfile,"/tmp/mapfile"); strcpy(mapfile,"/tmp/mapfile");
itos(getpid(), &mapfile[12]); itos(getpid(), &mapfile[12]);
if ((fd_mapfile = open(mapfile, O_RDWR|O_CREAT|O_TRUNC, 0666)) < 0) if ((fd_mapfile = open(mapfile, O_RDWR|O_CREAT|O_TRUNC, 0666)) < 0)
abort_optyap("open error in function open_mapfile: %s", strerror(errno)); abort_yapor("open error in function open_mapfile: %s", strerror(errno));
if (lseek(fd_mapfile, TotalArea, SEEK_SET) < 0) if (lseek(fd_mapfile, TotalArea, SEEK_SET) < 0)
abort_optyap("lseek error in function open_mapfile: %s", strerror(errno)); abort_yapor("lseek error in function open_mapfile: %s", strerror(errno));
if (write(fd_mapfile, "", 1) < 0) if (write(fd_mapfile, "", 1) < 0)
abort_optyap("write error in function open_mapfile: %s", strerror(errno)); abort_yapor("write error in function open_mapfile: %s", strerror(errno));
return; return;
} }
close_mapfile(void) { close_mapfile(void) {
if (close(fd_mapfile) < 0) if (close(fd_mapfile) < 0)
abort_optyap("close error in function close_mapfile: %s", strerror(errno)); abort_yapor("close error in function close_mapfile: %s", strerror(errno));
} }
#endif /* MMAP_MEMORY_MAPPING_SCHEME */ #endif /* MMAP_MEMORY_MAPPING_SCHEME */
@ -129,7 +129,7 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
open_mapfile(TotalArea); open_mapfile(TotalArea);
if ((mmap_addr = mmap((void *) MMAP_ADDR, (size_t) TotalArea, PROT_READ|PROT_WRITE, if ((mmap_addr = mmap((void *) MMAP_ADDR, (size_t) TotalArea, PROT_READ|PROT_WRITE,
MAP_SHARED|MAP_FIXED, fd_mapfile, 0)) == (void *) -1) MAP_SHARED|MAP_FIXED, fd_mapfile, 0)) == (void *) -1)
abort_optyap("mmap error in function map_memory: %s", strerror(errno)); abort_yapor("mmap error in function map_memory: %s", strerror(errno));
#else /* SHM_MEMORY_MAPPING_SCHEME */ #else /* SHM_MEMORY_MAPPING_SCHEME */
/* Most systems are limited regarding what we can allocate */ /* Most systems are limited regarding what we can allocate */
#ifdef ACOW #ifdef ACOW
@ -144,10 +144,10 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
#ifdef ACOW #ifdef ACOW
/* just allocate local space for stacks */ /* just allocate local space for stacks */
if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0) if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0)
abort_optyap("open error in function map_memory: %s", strerror(errno)); abort_yapor("open error in function map_memory: %s", strerror(errno));
if (mmap(Yap_GlobalBase, GlobalLocalArea + TrailAuxArea, PROT_READ|PROT_WRITE, if (mmap(Yap_GlobalBase, GlobalLocalArea + TrailAuxArea, PROT_READ|PROT_WRITE,
MAP_PRIVATE|MAP_FIXED, private_fd_mapfile, 0) == (void *) -1) MAP_PRIVATE|MAP_FIXED, private_fd_mapfile, 0) == (void *) -1)
abort_optyap("mmap error in function map_memory: %s", strerror(errno)); abort_yapor("mmap error in function map_memory: %s", strerror(errno));
close(private_fd_mapfile); close(private_fd_mapfile);
#else /* ENV_COPY || SBA */ #else /* ENV_COPY || SBA */
for (i = 0; i < n_workers; i++) { for (i = 0; i < n_workers; i++) {
@ -165,9 +165,9 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
/* alloc space for the sparse binding array */ /* alloc space for the sparse binding array */
sba_size = WorkerArea * n_workers; sba_size = WorkerArea * n_workers;
if ((binding_array = (char *)malloc(sba_size)) == NULL) if ((binding_array = (char *)malloc(sba_size)) == NULL)
abort_optyap("malloc error in function map_memory: %s", strerror(errno)); abort_yapor("malloc error in function map_memory: %s", strerror(errno));
if ((CELL)binding_array & MBIT) { if ((CELL)binding_array & MBIT) {
abort_optyap("OOPS: binding_array start address %p conflicts with tag %x used in IDB", binding_array, MBIT); abort_yapor("OOPS: binding_array start address %p conflicts with tag %x used in IDB", binding_array, MBIT);
} }
sba_offset = binding_array - Yap_GlobalBase; sba_offset = binding_array - Yap_GlobalBase;
sba_end = (int)binding_array + sba_size; sba_end = (int)binding_array + sba_size;
@ -175,17 +175,13 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
Yap_TrailBase = Yap_GlobalBase + GlobalLocalArea; Yap_TrailBase = Yap_GlobalBase + GlobalLocalArea;
Yap_LocalBase = Yap_TrailBase - CellSize; Yap_LocalBase = Yap_TrailBase - CellSize;
if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */ if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */
Yap_TrailTop = Yap_TrailBase + TrailAuxArea - 131072; /* 131072 = 262144 / 2 */ Yap_TrailTop = Yap_TrailBase + TrailAuxArea - 131072; /* 131072 = 262144 / 2 */
else else
Yap_TrailTop = Yap_TrailBase + TrailAuxArea / 2; Yap_TrailTop = Yap_TrailBase + TrailAuxArea / 2;
HeapMax = Yap_TrailBase + TrailAuxArea - CellSize; HeapMax = Yap_TrailBase + TrailAuxArea - CellSize;
Yap_InitHeap(mmap_addr); Yap_InitHeap(mmap_addr);
BaseWorkArea = mmap_addr;
} }
@ -261,26 +257,26 @@ void remap_memory(void) {
int i; int i;
remap_addr = worker_area(0); remap_addr = worker_area(0);
remap_offset = remap_addr - BaseWorkArea; remap_offset = remap_addr - Yap_HeapBase;
WorkerArea = worker_offset(1); WorkerArea = worker_offset(1);
#ifdef SHM_MEMORY_MAPPING_SCHEME #ifdef SHM_MEMORY_MAPPING_SCHEME
for (i = 0; i < number_workers; i++) { for (i = 0; i < number_workers; i++) {
if (shmdt(worker_area(i)) == -1) if (shmdt(worker_area(i)) == -1)
abort_optyap("shmdt error in function remap_memory"); abort_yapor("shmdt error in function remap_memory");
} }
for (i = 0; i < number_workers; i++) { for (i = 0; i < number_workers; i++) {
worker_area(i) = remap_addr + ((number_workers + i - worker_id) % number_workers) * WorkerArea; worker_area(i) = remap_addr + ((number_workers + i - worker_id) % number_workers) * WorkerArea;
if(shmat(shm_mapid[i], worker_area(i), 0) == (void *) -1) if(shmat(shm_mapid[i], worker_area(i), 0) == (void *) -1)
abort_optyap("shmat error in function remap_memory at %p: %s", worker_area(i), strerror(errno)); abort_yapor("shmat error in function remap_memory at %p: %s", worker_area(i), strerror(errno));
} }
#else /* MMAP_MEMORY_MAPPING_SCHEME */ #else /* MMAP_MEMORY_MAPPING_SCHEME */
if (munmap(remap_addr, (size_t)(WorkerArea * number_workers)) == -1) if (munmap(remap_addr, (size_t)(WorkerArea * number_workers)) == -1)
abort_optyap("munmap error in function remap_memory"); abort_yapor("munmap error in function remap_memory");
for (i = 0; i < number_workers; i++) { for (i = 0; i < number_workers; i++) {
worker_area(i) = remap_addr + ((number_workers + i - worker_id) % number_workers) * WorkerArea; worker_area(i) = remap_addr + ((number_workers + i - worker_id) % number_workers) * WorkerArea;
if (mmap(worker_area(i), (size_t)WorkerArea, PROT_READ|PROT_WRITE, if (mmap(worker_area(i), (size_t)WorkerArea, PROT_READ|PROT_WRITE,
MAP_SHARED|MAP_FIXED, fd_mapfile, remap_offset + i * WorkerArea) == (void *) -1) MAP_SHARED|MAP_FIXED, fd_mapfile, remap_offset + i * WorkerArea) == (void *) -1)
abort_optyap("mmap error in function remap_memory: %s", strerror(errno)); abort_yapor("mmap error in function remap_memory: %s", strerror(errno));
} }
#endif /* MEMORY_MAPPING_SCHEME */ #endif /* MEMORY_MAPPING_SCHEME */
for (i = 0; i < number_workers; i++) { for (i = 0; i < number_workers; i++) {

28
OPTYap/opt.misc.c
View File

@ -33,23 +33,29 @@ struct worker WORKER;
** Global functions ** ** Global functions **
** -------------------------- */ ** -------------------------- */
void abort_optyap(const char *msg, ...) { #ifdef TABLING
void abort_yaptab(const char *msg, ...) {
va_list args; va_list args;
va_start(args, msg); va_start(args, msg);
fprintf(stderr, "[ "); fprintf(stderr, "[ Fatal YapTab Error: ");
#ifdef YAPOR
fprintf (stderr, "Worker %d ", worker_id);
#endif /* YAPOR */
fprintf (stderr, "Aborting OPTYap -> ");
vfprintf(stderr, msg, args); vfprintf(stderr, msg, args);
fprintf(stderr, " ]\n"); fprintf(stderr, " ]\n");
#ifdef YAPOR
unmap_memory();
#endif /* YAPOR */
exit (1); exit (1);
} }
#endif /* TABLING */
#ifdef YAPOR
void abort_yapor(const char *msg, ...) {
va_list args;
va_start(args, msg);
fprintf(stderr, "[ Fatal YapOr Error: ");
vfprintf(stderr, msg, args);
fprintf(stderr, " (worker %d exiting...) ]\n", worker_id);
unmap_memory();
exit (1);
}
#endif /* YAPOR */
void itos(int i, char *s) { void itos(int i, char *s) {

37
OPTYap/opt.preds.c
View File

@ -53,10 +53,10 @@ static void answer_to_stdout(char *answer);
static int p_table(void); static int p_table(void);
static int p_abolish_trie(void); static int p_abolish_trie(void);
static int p_show_trie(void); static int p_show_trie(void);
static int p_resume_trie(void); static int p_show_trie_stats(void);
#endif /* TABLING */ #endif /* TABLING */
#ifdef STATISTICS #ifdef STATISTICS
static int p_show_frames(void); static int p_show_frames_stats(void);
#endif /* STATISTICS */ #endif /* STATISTICS */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS) #if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
static int p_debug_prolog(void); static int p_debug_prolog(void);
@ -82,11 +82,11 @@ void Yap_init_optyap_preds(void) {
#ifdef TABLING #ifdef TABLING
Yap_InitCPred("$do_table", 2, p_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$do_table", 2, p_table, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_abolish_trie", 2, p_abolish_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$do_abolish_trie", 2, p_abolish_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$show_trie", 3, p_show_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$do_show_trie", 2, p_show_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$resume_trie", 2, p_resume_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$do_show_trie_stats", 2, p_show_trie_stats, SafePredFlag|SyncPredFlag|HiddenPredFlag);
#endif /* TABLING */ #endif /* TABLING */
#ifdef STATISTICS #ifdef STATISTICS
Yap_InitCPred("show_frames", 0, p_show_frames, SafePredFlag|SyncPredFlag); Yap_InitCPred("show_frames_stats", 0, p_show_frames_stats, SafePredFlag|SyncPredFlag);
#endif /* STATISTICS */ #endif /* STATISTICS */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS) #if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
Yap_InitCPred("debug_prolog", 1, p_debug_prolog, SafePredFlag|SyncPredFlag); Yap_InitCPred("debug_prolog", 1, p_debug_prolog, SafePredFlag|SyncPredFlag);
@ -449,7 +449,7 @@ int p_table(void) {
tab_ent_ptr te; tab_ent_ptr te;
sg_node_ptr sg_node; sg_node_ptr sg_node;
tmod = Deref(ARG2); mod = Deref(ARG2);
if (IsVarTerm(mod) || !IsAtomTerm(mod)) { if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
return (FALSE); return (FALSE);
} }
@ -509,7 +509,7 @@ int p_abolish_trie(void) {
static static
int p_show_trie(void) { int p_show_trie(void) {
Term t1, t2, mod; Term t1, mod;
PredEntry *pe; PredEntry *pe;
Atom at; Atom at;
UInt arity; UInt arity;
@ -531,31 +531,17 @@ int p_show_trie(void) {
} else { } else {
return (FALSE); return (FALSE);
} }
t2 = Deref(ARG3); traverse_trie(stdout, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
if (IsVarTerm(t2)) {
Term ta = MkAtomTerm(Yap_LookupAtom("stdout"));
Bind((CELL *)t2, ta);
traverse_trie(stderr, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
} else if (IsAtomTerm(t2)) {
FILE *file;
char *path = RepAtom(AtomOfTerm(t2))->StrOfAE;
if ((file = fopen(path, "w")) == NULL)
abort_optyap("fopen error in function p_show_trie");
traverse_trie(file, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
fclose(file);
} else {
return(FALSE);
}
return (TRUE); return (TRUE);
} }
static static
int p_resume_trie(void) { int p_show_trie_stats(void) {
Term t, mod; Term t, mod;
PredEntry *pe; PredEntry *pe;
Atom at; Atom at;
int arity; UInt arity;
mod = Deref(ARG2); mod = Deref(ARG2);
if (IsVarTerm(mod) || !IsAtomTerm(mod)) { if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
@ -582,7 +568,7 @@ int p_resume_trie(void) {
#ifdef STATISTICS #ifdef STATISTICS
static static
int p_show_frames(void) { int p_show_frames_stats(void) {
long cont, pages; long cont, pages;
pg_hd_ptr pg_hd; pg_hd_ptr pg_hd;
void *str_ptr; void *str_ptr;
@ -836,7 +822,6 @@ int p_show_frames(void) {
} }
fprintf(stdout, " %s[%ld] Pages: In Use %ld - Free %ld (%ld Accesses)\n]\n\n", fprintf(stdout, " %s[%ld] Pages: In Use %ld - Free %ld (%ld Accesses)\n]\n\n",
(Pg_str_alloc(GLOBAL_PAGES_void) - Pg_str_in_use(GLOBAL_PAGES_void) == cont && (Pg_str_alloc(GLOBAL_PAGES_void) - Pg_str_in_use(GLOBAL_PAGES_void) == cont &&
TopAllocArea - BaseAllocArea == Yap_page_size * Pg_str_alloc(GLOBAL_PAGES_void) &&
Pg_str_in_use(GLOBAL_PAGES_void) == pages) ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_void) == pages) ? " ": "*",
Pg_str_alloc(GLOBAL_PAGES_void), Pg_str_alloc(GLOBAL_PAGES_void),
Pg_str_in_use(GLOBAL_PAGES_void), cont, Pg_requests(GLOBAL_PAGES_void)); Pg_str_in_use(GLOBAL_PAGES_void), cont, Pg_requests(GLOBAL_PAGES_void));

8
OPTYap/opt.proto.h
View File

@ -23,7 +23,12 @@ void remap_memory(void);
** opt.misc.c ** ** opt.misc.c **
** ------------ */ ** ------------ */
void abort_optyap(const char *msg, ...); #ifdef TABLING
void abort_yaptab(const char *msg, ...);
#endif /* TABLING */
#ifdef YAPOR
void abort_yapor(const char *msg, ...);
#endif /* YAPOR */
void itos(int i, char *s); void itos(int i, char *s);
void information_message(const char *mesg,...); void information_message(const char *mesg,...);
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS) #if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
@ -41,7 +46,6 @@ void make_root_frames(void);
#ifdef YAPOR #ifdef YAPOR
void init_workers(void); void init_workers(void);
#endif /* YAPOR */ #endif /* YAPOR */
void init_signals(void);
/* ------------- ** /* ------------- **

7
OPTYap/opt.structs.h
View File

@ -117,9 +117,6 @@ struct global_locks {
struct global_data{ struct global_data{
/* global data related to memory management */ /* global data related to memory management */
void *BaseWorkArea;
void *BaseAllocArea;
void *TopAllocArea;
struct global_pages pages; struct global_pages pages;
#ifdef YAPOR #ifdef YAPOR
@ -170,10 +167,6 @@ struct global_data{
#endif /* TABLING */ #endif /* TABLING */
}; };
#define BaseWorkArea (GLOBAL.BaseWorkArea)
#define TopWorkArea (GLOBAL.TopWorkArea)
#define BaseAllocArea (GLOBAL.BaseAllocArea)
#define TopAllocArea (GLOBAL.TopAllocArea)
#define GLOBAL_PAGES_void (GLOBAL.pages.void_pages) #define GLOBAL_PAGES_void (GLOBAL.pages.void_pages)
#define GLOBAL_PAGES_or_fr (GLOBAL.pages.or_frame_pages) #define GLOBAL_PAGES_or_fr (GLOBAL.pages.or_frame_pages)
#define GLOBAL_PAGES_qg_sol_fr (GLOBAL.pages.query_goal_solution_frame_pages) #define GLOBAL_PAGES_qg_sol_fr (GLOBAL.pages.query_goal_solution_frame_pages)

2
OPTYap/or.cowengine.c
View File

@ -187,7 +187,7 @@ void share_private_nodes(int worker_q) {
} }
/* update depth */ /* update depth */
if (depth >= MAX_DEPTH) if (depth >= MAX_DEPTH)
abort_optyap("maximum depth exceded (%d/%d) (share_private_nodes)", MAX_DEPTH, depth - MAX_DEPTH); abort_yapor("maximum depth exceded (%d/%d) (share_private_nodes)", MAX_DEPTH, depth - MAX_DEPTH);
or_frame = B->cp_or_fr; or_frame = B->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) { while (or_frame != LOCAL_top_or_fr) {
unsigned int branch; unsigned int branch;

2
OPTYap/or.engine.c
View File

@ -575,7 +575,7 @@ void share_private_nodes(int worker_q) {
/* update depth */ /* update depth */
if (depth >= MAX_DEPTH) if (depth >= MAX_DEPTH)
abort_optyap("maximum depth exceded (%d/%d) (share_private_nodes)", depth, MAX_DEPTH); abort_yapor("maximum depth exceded (%d/%d) (share_private_nodes)", depth, MAX_DEPTH);
or_frame = B->cp_or_fr; or_frame = B->cp_or_fr;
#ifdef TABLING #ifdef TABLING
previous_or_frame = LOCAL_top_cp_on_stack->cp_or_fr; previous_or_frame = LOCAL_top_cp_on_stack->cp_or_fr;

2
OPTYap/or.sbaengine.c
View File

@ -251,7 +251,7 @@ void share_private_nodes(int worker_q) {
} }
/* update depth */ /* update depth */
if (depth >= MAX_DEPTH) if (depth >= MAX_DEPTH)
abort_optyap("maximum depth exceded (%d/%d) (share_private_nodes)", MAX_DEPTH, depth - MAX_DEPTH); abort_yapor("maximum depth exceded (%d/%d) (share_private_nodes)", MAX_DEPTH, depth - MAX_DEPTH);
or_frame = B->cp_or_fr; or_frame = B->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) { while (or_frame != LOCAL_top_or_fr) {

57
OPTYap/tab.insts.i
View File

@ -21,19 +21,20 @@
#endif /* TABLING_SCHEDULING */ #endif /* TABLING_SCHEDULING */
#define store_generator_node(PTR, ARITY, AP, SG_FR) \ #define store_generator_node(ARITY, AP, SG_FR) \
{ register CELL *pt_args; \ { register CELL *pt_args; \
register gen_cp_ptr gcp; \ register gen_cp_ptr gcp; \
/* store args */ \ /* store args */ \
pt_args = XREGS + (ARITY); \ pt_args = XREGS + (ARITY); \
while (pt_args > XREGS) { \ while (pt_args > XREGS) { \
register CELL aux_arg = pt_args[0]; \ register CELL aux_arg = pt_args[0]; \
--PTR; \ --YENV; \
--pt_args; \ --pt_args; \
*PTR = aux_arg; \ *YENV = aux_arg; \
} \ } \
/* initialize gcp and adjust subgoal frame field */ \ /* initialize gcp and adjust subgoal frame field */ \
gcp = --GEN_CP(PTR); \ YENV = (CELL *) (GEN_CP(YENV) - 1); \
gcp = GEN_CP(YENV); \
SgFr_gen_cp(SG_FR) = NORM_CP(gcp); \ SgFr_gen_cp(SG_FR) = NORM_CP(gcp); \
/* store generator choice point */ \ /* store generator choice point */ \
HBREG = H; \ HBREG = H; \
@ -51,9 +52,9 @@
} }
#define restore_generator_node(PTR, ARITY, AP) \ #define restore_generator_node(ARITY, AP) \
{ register CELL *pt_args, *x_args; \ { register CELL *pt_args, *x_args; \
register gen_cp_ptr gcp = GEN_CP(PTR); \ register gen_cp_ptr gcp = GEN_CP(B); \
/* restore generator choice point */ \ /* restore generator choice point */ \
H = HBREG = PROTECT_FROZEN_H(NORM_CP(gcp)); \ H = HBREG = PROTECT_FROZEN_H(NORM_CP(gcp)); \
CPREG = gcp->gcp_cp; \ CPREG = gcp->gcp_cp; \
@ -72,9 +73,9 @@
} }
#define pop_generator_node(PTR, ARITY) \ #define pop_generator_node(ARITY) \
{ register CELL *pt_args, *x_args; \ { register CELL *pt_args, *x_args; \
register gen_cp_ptr gcp = GEN_CP(PTR); \ register gen_cp_ptr gcp = GEN_CP(B); \
/* pop generator choice point */ \ /* pop generator choice point */ \
H = PROTECT_FROZEN_H(NORM_CP(gcp)); \ H = PROTECT_FROZEN_H(NORM_CP(gcp)); \
CPREG = gcp->gcp_cp; \ CPREG = gcp->gcp_cp; \
@ -96,11 +97,12 @@
} }
#define store_consumer_node(PTR, SG_FR, LEADER_CP, DEP_ON_STACK) \ #define store_consumer_node(SG_FR, LEADER_CP, DEP_ON_STACK) \
{ register cons_cp_ptr ccp; \ { register cons_cp_ptr ccp; \
register dep_fr_ptr new_dep_fr; \ register dep_fr_ptr new_dep_fr; \
/* initialize ccp */ \ /* initialize ccp */ \
ccp = --CONS_CP(PTR); \ YENV = (CELL *) (CONS_CP(YENV) - 1); \
ccp = CONS_CP(YENV); \
/* adjust freeze registers */ \ /* adjust freeze registers */ \
H_FZ = H; \ H_FZ = H; \
B_FZ = NORM_CP(ccp); \ B_FZ = NORM_CP(ccp); \
@ -175,6 +177,7 @@
#ifdef TABLING_INNER_CUTS #ifdef TABLING_INNER_CUTS
Op(clause_with_cut, e) Op(clause_with_cut, e)
/*printf("estou aqui - clause_with_cut\n");*/
if (LOCAL_pruning_scope) { if (LOCAL_pruning_scope) {
if (YOUNGER_CP(LOCAL_pruning_scope, B)) if (YOUNGER_CP(LOCAL_pruning_scope, B))
LOCAL_pruning_scope = B; LOCAL_pruning_scope = B;
@ -195,6 +198,7 @@
sg_fr_ptr sg_fr; sg_fr_ptr sg_fr;
CELL *Yaddr; CELL *Yaddr;
/*printf("estou aqui - table_try_single\n");*/
Yaddr = YENV; Yaddr = YENV;
check_trail(); check_trail();
tab_ent = PREG->u.ld.te; tab_ent = PREG->u.ld.te;
@ -220,7 +224,7 @@
UNLOCK_TABLE(sg_node); UNLOCK_TABLE(sg_node);
#endif /* TABLE_LOCK_LEVEL */ #endif /* TABLE_LOCK_LEVEL */
LOCAL_top_sg_fr = sg_fr; LOCAL_top_sg_fr = sg_fr;
store_generator_node(YENV, PREG->u.ld.s, COMPLETION, sg_fr); store_generator_node(PREG->u.ld.s, COMPLETION, sg_fr);
PREG = PREG->u.ld.d; PREG = PREG->u.ld.d;
PREFETCH_OP(PREG); PREFETCH_OP(PREG);
allocate_environment(YENV); allocate_environment(YENV);
@ -265,7 +269,7 @@
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack); find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
UNLOCK(SgFr_lock(sg_fr)); UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack); find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(YENV, sg_fr, leader_cp, leader_dep_on_stack); store_consumer_node(sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS #ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) { if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp; choiceptr aux_cp;
@ -294,6 +298,7 @@
sg_fr_ptr sg_fr; sg_fr_ptr sg_fr;
CELL *Yaddr; CELL *Yaddr;
/*printf("estou aqui - table_try_me\n");*/
Yaddr = YENV; Yaddr = YENV;
check_trail(); check_trail();
tab_ent = PREG->u.ld.te; tab_ent = PREG->u.ld.te;
@ -319,7 +324,7 @@
UNLOCK_TABLE(sg_node); UNLOCK_TABLE(sg_node);
#endif /* TABLE_LOCK_LEVEL */ #endif /* TABLE_LOCK_LEVEL */
LOCAL_top_sg_fr = sg_fr; LOCAL_top_sg_fr = sg_fr;
store_generator_node(YENV, PREG->u.ld.s, PREG->u.ld.d, sg_fr); store_generator_node(PREG->u.ld.s, PREG->u.ld.d, sg_fr);
PREG = NEXTOP(PREG, ld); PREG = NEXTOP(PREG, ld);
PREFETCH_OP(PREG); PREFETCH_OP(PREG);
allocate_environment(YENV); allocate_environment(YENV);
@ -364,7 +369,7 @@
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack); find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
UNLOCK(SgFr_lock(sg_fr)); UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack); find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(YENV, sg_fr, leader_cp, leader_dep_on_stack); store_consumer_node(sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS #ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) { if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp; choiceptr aux_cp;
@ -392,6 +397,7 @@
sg_fr_ptr sg_fr; sg_fr_ptr sg_fr;
CELL *Yaddr; CELL *Yaddr;
/*printf("estou aqui - table_try\n");*/
Yaddr = YENV; Yaddr = YENV;
check_trail(); check_trail();
tab_ent = PREG->u.ld.te; tab_ent = PREG->u.ld.te;
@ -417,7 +423,7 @@
UNLOCK_TABLE(sg_node); UNLOCK_TABLE(sg_node);
#endif /* TABLE_LOCK_LEVEL */ #endif /* TABLE_LOCK_LEVEL */
LOCAL_top_sg_fr = sg_fr; LOCAL_top_sg_fr = sg_fr;
store_generator_node(YENV, PREG->u.ld.s, NEXTOP(PREG,ld), sg_fr); store_generator_node(PREG->u.ld.s, NEXTOP(PREG,ld), sg_fr);
PREG = PREG->u.ld.d; PREG = PREG->u.ld.d;
PREFETCH_OP(PREG); PREFETCH_OP(PREG);
allocate_environment(YENV); allocate_environment(YENV);
@ -462,7 +468,7 @@
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack); find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
UNLOCK(SgFr_lock(sg_fr)); UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack); find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(YENV, sg_fr, leader_cp, leader_dep_on_stack); store_consumer_node(sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS #ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) { if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp; choiceptr aux_cp;
@ -486,7 +492,8 @@
Op(table_retry, ld) Op(table_retry, ld)
restore_generator_node(B, PREG->u.ld.s, NEXTOP(PREG,ld)); /*printf("estou aqui - table_retry\n");*/
restore_generator_node(PREG->u.ld.s, NEXTOP(PREG,ld));
YENV = (CELL *) PROTECT_FROZEN_B(B); YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b); set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV)); SET_BB(NORM_CP(YENV));
@ -497,7 +504,8 @@
Op(table_retry_me, ld) Op(table_retry_me, ld)
restore_generator_node(B, PREG->u.ld.s, PREG->u.ld.d); /*printf("estou aqui - table_retry_me\n");*/
restore_generator_node(PREG->u.ld.s, PREG->u.ld.d);
YENV = (CELL *) PROTECT_FROZEN_B(B); YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b); set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV)); SET_BB(NORM_CP(YENV));
@ -509,7 +517,8 @@
Op(table_trust_me, ld) Op(table_trust_me, ld)
restore_generator_node(B, PREG->u.ld.s, COMPLETION); /*printf("estou aqui - table_trust_me\n");*/
restore_generator_node(PREG->u.ld.s, COMPLETION);
YENV = (CELL *) PROTECT_FROZEN_B(B); YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b); set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV)); SET_BB(NORM_CP(YENV));
@ -519,7 +528,8 @@
ENDOp(); ENDOp();
Op(table_trust, ld) Op(table_trust, ld)
restore_generator_node(B, PREG->u.ld.s, COMPLETION); /*printf("estou aqui - table_trust\n");*/
restore_generator_node(PREG->u.ld.s, COMPLETION);
YENV = (CELL *) PROTECT_FROZEN_B(B); YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b); set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV)); SET_BB(NORM_CP(YENV));
@ -535,6 +545,7 @@
sg_fr_ptr sg_fr; sg_fr_ptr sg_fr;
ans_node_ptr ans_node; ans_node_ptr ans_node;
/*printf("estou aqui - table_new_answer\n");*/
/* possible optimization: when the number of substitution variables ** /* possible optimization: when the number of substitution variables **
** is zero, an answer is sufficient to perform an early completion */ ** is zero, an answer is sufficient to perform an early completion */
gcp = GEN_CP(YENV[E_B]); gcp = GEN_CP(YENV[E_B]);
@ -755,6 +766,7 @@
BOp(table_answer_resolution, ld) BOp(table_answer_resolution, ld)
/*printf("estou aqui - table_answer_resolution\n");*/
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr); UNLOCK_OR_FRAME(LOCAL_top_or_fr);
@ -1046,6 +1058,7 @@
BOp(table_completion, ld); BOp(table_completion, ld);
/*printf("estou aqui - table_completion\n");*/
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_new_alternative(PREG, GEN_CP_NULL_ALT); SCH_new_alternative(PREG, GEN_CP_NULL_ALT);
@ -1070,7 +1083,7 @@
completion: completion:
/*printf("estou aqui - completion\n");*/
INIT_PREFETCH() INIT_PREFETCH()
dep_fr_ptr dep_fr; dep_fr_ptr dep_fr;
@ -1361,7 +1374,7 @@
TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (completion)"); TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (completion)");
} }
#endif /* TABLING_ERRORS */ #endif /* TABLING_ERRORS */
pop_generator_node(B, SgFr_arity(sg_fr)); pop_generator_node(SgFr_arity(sg_fr));
if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) { if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */ /* yes answer --> procceed */
PREG = (yamop *) CPREG; PREG = (yamop *) CPREG;

21
OPTYap/tab.macros.h
View File

@ -67,12 +67,10 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
#define GEN_CP(CP) ((gen_cp_ptr)(CP)) #define GEN_CP(CP) ((gen_cp_ptr)(CP))
#define CONS_CP(CP) ((cons_cp_ptr)(CP)) #define CONS_CP(CP) ((cons_cp_ptr)(CP))
#define TAG_AS_ANSWER_LEAF_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((unsigned int)TrNode_parent(NODE) | 0x1)
#define TAG_AS_ANSWER_LEAF_NODE(NODE) ((unsigned int)TrNode_parent(NODE) |= 0x1)
#define UNTAG_ANSWER_LEAF_NODE(NODE) ((ans_node_ptr)((unsigned int)NODE & 0xfffffffe)) #define UNTAG_ANSWER_LEAF_NODE(NODE) ((ans_node_ptr)((unsigned int)NODE & 0xfffffffe))
#define IS_ANSWER_LEAF_NODE(NODE) ((unsigned int)TrNode_parent(NODE) & 0x1) #define IS_ANSWER_LEAF_NODE(NODE) ((unsigned int)TrNode_parent(NODE) & 0x1)
#define FREE_STACK_PUSH(ITEM, STACK) *--STACK = (CELL)(ITEM) #define FREE_STACK_PUSH(ITEM, STACK) *--STACK = (CELL)(ITEM)
#define STACK_TOP(STACK) *STACK #define STACK_TOP(STACK) *STACK
#define STACK_POP(STACK) *STACK++ #define STACK_POP(STACK) *STACK++
@ -82,20 +80,21 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \ #define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
*--STACK = (CELL)(ITEM); \ *--STACK = (CELL)(ITEM); \
if (STACK <= STACK_TOP) \ if (STACK <= STACK_TOP) \
abort_optyap("auxiliary stack full") abort_yapor("auxiliary stack full")
#else #else
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \ #define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
*--(STACK) = (CELL)(ITEM); \ *--(STACK) = (CELL)(ITEM); \
if ((STACK) <= STACK_TOP + 1024) { \ if ((STACK) <= STACK_TOP + 1024) { \
void *old_top = Yap_TrailTop; \
CELL *NEW_STACK; \ CELL *NEW_STACK; \
UInt diff; \ UInt diff; \
char *OldTrailTop = (char *)Yap_TrailTop; \ abort_yaptab("auxiliary stack full"); \
Yap_growtrail(64 * 1024L); \ Yap_growtrail(64 * 1024L, TRUE); \
diff = (char *)Yap_TrailTop - OldTrailTop; \ diff = (void *)Yap_TrailTop - old_top; \
NEW_STACK = (CELL *)((char *)(STACK)+diff); \ NEW_STACK = (CELL *)((void *)(STACK) + diff); \
memmove((void *)NEW_STACK, (void *)(STACK), (char *)OldTrailTop-(char *)STACK); \ memmove((void *)NEW_STACK, (void *)(STACK), old_top - (void *)STACK); \
(STACK) = NEW_STACK; \ (STACK) = NEW_STACK; \
(STACK_BASE) = (CELL *)((char *)(STACK_BASE)+diff); \ (STACK_BASE) = (CELL *)((void *)(STACK_BASE) + diff); \
} }
#endif /* YAPOR */ #endif /* YAPOR */
@ -494,7 +493,7 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
static inline static inline
void pruning_over_tabling_data_structures(void) { void pruning_over_tabling_data_structures(void) {
abort_optyap("pruning over tabling data structures"); abort_yaptab("pruning over tabling data structures");
return; return;
} }

14
OPTYap/tab.tries.c
View File

@ -704,7 +704,7 @@ sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base); STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base);
break; break;
default: default:
abort_optyap("unknown type tag in function subgoal_search"); abort_yaptab("unknown type tag in function subgoal_search");
} }
} while (STACK_NOT_EMPTY(stack_terms, stack_terms_base)); } while (STACK_NOT_EMPTY(stack_terms, stack_terms_base));
} }
@ -778,7 +778,7 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base); STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base);
break; break;
default: default:
abort_optyap("unknown type tag in function answer_search"); abort_yaptab("unknown type tag in function answer_search");
} }
} while (STACK_NOT_EMPTY(stack_terms, stack_terms_base)); } while (STACK_NOT_EMPTY(stack_terms, stack_terms_base));
} }
@ -869,7 +869,7 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base); STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base);
} break; } break;
default: default:
abort_optyap("unknown type tag in macro load_answer_trie"); abort_yaptab("unknown type tag in macro load_answer_trie");
} }
while (STACK_NOT_EMPTY(stack_refs, stack_refs_base)) { while (STACK_NOT_EMPTY(stack_refs, stack_refs_base)) {
CELL *ref = (CELL *) STACK_POP(stack_refs); CELL *ref = (CELL *) STACK_POP(stack_refs);
@ -913,7 +913,7 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base); STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base);
} break; } break;
default: default:
abort_optyap("unknown type tag in macro load_answer_trie"); abort_yaptab("unknown type tag in macro load_answer_trie");
} }
} }
} }
@ -975,7 +975,7 @@ void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes) {
missing_nodes += ArityOfFunctor((Functor)NonTagPart(t)); missing_nodes += ArityOfFunctor((Functor)NonTagPart(t));
break; break;
default: default:
abort_optyap("unknown type tag in function chain_subgoal_frames"); abort_yaptab("unknown type tag in function chain_subgoal_frames");
} }
if (missing_nodes) { if (missing_nodes) {
free_subgoal_trie_branch(TrNode_child(node), missing_nodes); free_subgoal_trie_branch(TrNode_child(node), missing_nodes);
@ -1281,7 +1281,7 @@ int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_
arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t)); arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t));
break; break;
default: default:
abort_optyap("unknown type tag in function traverse_subgoal_trie"); abort_yaptab("unknown type tag in function traverse_subgoal_trie");
} }
if (! traverse_subgoal_trie(stream, TrNode_child(sg_node), str, str_index, arity, depth + 1)) if (! traverse_subgoal_trie(stream, TrNode_child(sg_node), str, str_index, arity, depth + 1))
@ -1409,7 +1409,7 @@ int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str
arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t)); arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t));
break; break;
default: default:
abort_optyap("unknown type tag in function traverse_answer_trie"); abort_yaptab("unknown type tag in function traverse_answer_trie");
} }
if (! IS_ANSWER_LEAF_NODE(ans_node)) { if (! IS_ANSWER_LEAF_NODE(ans_node)) {

15
OPTYap/tab.tries.insts.i
View File

@ -60,9 +60,10 @@
** macro because there are no cuts in trie instructions. ** ** macro because there are no cuts in trie instructions. **
** -------------------------------------------------------------- */ ** -------------------------------------------------------------- */
#define store_trie_choice_point(PTR, AP) \ #define store_trie_choice_point(AP) \
{ register choiceptr cp; \ { register choiceptr cp; \
cp = --NORM_CP(PTR); \ YENV = (CELL *) (NORM_CP(YENV) - 1); \
cp = NORM_CP(YENV); \
HBREG = H; \ HBREG = H; \
cp->cp_tr = TR; \ cp->cp_tr = TR; \
cp->cp_h = H; \ cp->cp_h = H; \
@ -451,7 +452,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
int i; int i;
store_trie_choice_point(YENV, TrNode_next(node)); store_trie_choice_point(TrNode_next(node));
cp_trie_var_instr(); cp_trie_var_instr();
ENDPBOp(); ENDPBOp();
@ -520,7 +521,7 @@
int var_index = VarIndexOfTableTerm(TrNode_entry(node)); int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i; int i;
store_trie_choice_point(YENV, TrNode_next(node)); store_trie_choice_point(TrNode_next(node));
cp_trie_val_instr(); cp_trie_val_instr();
ENDPBOp(); ENDPBOp();
@ -587,7 +588,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
int i; int i;
store_trie_choice_point(YENV, TrNode_next(node)); store_trie_choice_point(TrNode_next(node));
cp_trie_atom_instr(); cp_trie_atom_instr();
ENDPBOp(); ENDPBOp();
@ -650,7 +651,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
int i; int i;
store_trie_choice_point(YENV, TrNode_next(node)); store_trie_choice_point(TrNode_next(node));
cp_trie_list_instr(); cp_trie_list_instr();
ENDPBOp(); ENDPBOp();
@ -717,7 +718,7 @@
int func_arity = ArityOfFunctor(func); int func_arity = ArityOfFunctor(func);
int i; int i;
store_trie_choice_point(YENV, TrNode_next(node)); store_trie_choice_point(TrNode_next(node));
cp_trie_struct_instr(); cp_trie_struct_instr();
ENDPBOp(); ENDPBOp();

147
pl/tabling.yap
View File

@ -15,120 +15,71 @@
* * * *
*************************************************************************/ *************************************************************************/
:- meta_predicate table(:), abolish_trie(:), show_trie(:), resume_trie(:). :- meta_predicate table(:), abolish_trie(:), show_trie(:), show_trie_stats(:).
table(M:X) :- !, table(M:P) :- !, '$table'(P,M).
'$table'(X, M). table(P) :- '$current_module'(M), '$table'(P,M).
table(X) :-
'$current_module'(M),
'$table'(X, M).
'$table'(X, _) :- var(X), !, '$table'(P,M) :- var(P), !, '$do_error'(instantiation_error,table).
write(user_error, '[ Error: argument to table/1 should be a predicate ]'), '$table'((P1,P2),M) :- !, '$table'(P1,M), '$table'(P2,M).
nl(user_error), '$table'(P/N,M) :- integer(N), atom(P), !,
fail. functor(T,P,N), '$declare_tabled'(T,M).
'$table'(M:A, _) :- !, '$table'(A, M). '$table'(P,M) :- '$do_error'(type_error(callable,P),table).
'$table'((A,B), M) :- !, '$table'(A, M), '$table'(B, M).
'$table'(A/N, M) :- integer(N), atom(A), !,
functor(P, A, N),
'$declare_tabled'(P, M).
'$table'(X, _) :- write(user_error, '[ Error: '),
write(user_error, X),
write(user_error, ' is an invalid argument to table/1 ]'),
nl(user_error),
fail.
'$declare_tabled'(P, M) :- '$declare_tabled'(T,M) :- '$undefined'(T,M), !, '$do_table'(T,M).
'$undefined'(P, M), !, '$declare_tabled'(T,M) :- '$flags'(T,M,F,F),
'$do_table'(P, M). X is F /\ 0x1991F880, X =:= 0, !, '$do_table'(T,M).
'$declare_tabled'(P, M) :- '$declare_tabled'(T,M) :- functor(T,A,N),
'$flags'(P,M,F,F), '$do_error'(permission_error(modify,static_procedure,A/N),tabled(M:A/N)).
X is F /\ 0x1991F880, X =:= 0, !,
'$do_table'(P, M).
'$declare_tabled'(P, M) :-
functor(P, A, N),
'$do_error'(permission_error(modify,static_procedure,A/N),tabled(Mod:A/N)).
abolish_trie(M:X) :- !, abolish_trie(M:P) :- !, '$abolish_trie'(P,M).
'$abolish_trie'(X, M). abolish_trie(P) :- '$current_module'(M), '$abolish_trie'(P,M).
abolish_trie(X) :-
'$current_module'(M),
'$abolish_trie'(X, M).
'$abolish_trie'(X, _M) :- var(X), !, '$abolish_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,abolish_trie).
write(user_error, '[ Error: argument to abolish_trie/1 should be a predicate ]'), '$abolish_trie'((P1,P2),M) :- !, '$abolish_trie'(P1,M), '$abolish_trie'(P2,M).
nl(user_error), '$abolish_trie'(P/N,M) :- integer(N), atom(P), !,
fail. functor(T,P,N), '$flags'(T,M,F,F),
'$abolish_trie'((A,B), _) :- !, '$abolish_trie'(A, M), '$abolish_trie'(B, M).
'$abolish_trie'(M:A, _) :- !, '$abolish_trie'(A, M).
'$abolish_trie'(A/N, M) :- integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,M,F,F),
( (
X is F /\ 0x000040, X =\= 0, !, '$do_abolish_trie'(T,M) X is F /\ 0x000040, X =\= 0, !, '$do_abolish_trie'(T,M)
; ;
write(user_error, '[ Error: '), write(user_error, '[ PERMISSION ERROR- '),
write(user_error, M:A/N), write(user_error, M:P/N),
write(user_error, ' is not declared as table ]'), write(user_error, ' is not tabled ]'),
nl(user_error), nl(user_error), fail
fail
). ).
'$abolish_trie'(X,M) :- write(user_error, '[ Error: '), '$abolish_trie'(P,_) :- '$do_error'(type_error(callable,P),abolish_trie).
write(user_error, M:X),
write(user_error, ' is an invalid argument to abolish_trie/1 ]'),
nl(user_error),
fail.
show_trie(M:X) :- !, show_trie(M:P) :- !, '$show_trie'(P,M).
'$show_trie'(X, M). show_trie(P) :- '$current_module'(M), '$show_trie'(P,M).
show_trie(X) :-
'$current_module'(M),
'$show_trie'(X, M).
'$show_trie'(X, M) :- var(X), !, '$show_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie).
'$do_error'(instantiation_error,show_trie(M:X)). '$show_trie'((P1,P2),M) :- !, '$show_trie'(P1,M), '$show_trie'(P2,M).
'$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M). '$show_trie'(P/N, M) :- integer(N), atom(P), !,
'$show_trie'(M:A, _) :- !, '$show_trie'(A, M). functor(T,P,N), '$flags'(T,M,F,F),
'$show_trie'(A/N, M) :- integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,M,F,F),
( (
X is F /\ 0x000040, X =\= 0, !, '$show_trie'(T,M,_) X is F /\ 0x000040, X =\= 0, !, '$do_show_trie'(T,M)
; ;
write(user_error, '[ Error: '), write(user_error, '[ PERMISSION ERROR- '),
write(user_error, M:A/N), write(user_error, M:P/N),
write(user_error, ' is not declared as table ]'), write(user_error, ' is not tabled ]'),
nl(user_error), nl(user_error), fail
fail
). ).
'$show_trie'(X, M) :- write(user_error, '[ Error: '), '$show_trie'(P,_) :- '$do_error'(type_error(callable,P),show_trie).
write(user_error, M:X),
write(user_error, ' is an invalid argument to trie/1 ]'),
nl(user_error),
fail.
resume_trie(M:X) :- !, show_trie_stats(M:P) :- !,'$show_trie_stats'(P,M).
'$resume_trie'(X, M). show_trie_stats(P) :- '$current_module'(M), '$show_trie_stats'(P,M).
resume_trie(X) :-
'$current_module'(M),
'$resume_trie'(X, M).
'$show_trie_stats'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie_stats).
'$resume_trie'(X,_) :- var(X), !, '$show_trie_stats'((P1,P2),M) :- !, '$show_trie_stats'(P1,M), '$show_trie_stats'(P2,M).
write(user_error, '[ Error: argument to trie/1 should be a predicate ]'), '$show_trie_stats'(P/N,M) :- atom(P), integer(N), !,
nl(user_error), functor(T,P,N), '$flags'(T,M,F,F),
fail.
'$resume_trie'(A/N,M) :- atom(A), integer(N), !,
functor(T,A,N), '$flags'(T,M,F,F),
( (
X is F /\ 0x000040, X =\= 0, !, '$resume_trie'(T,M) X is F /\ 0x000040, X =\= 0, !, '$do_show_trie_stats'(T,M)
; ;
write(user_error, '[ Error: '), write(user_error, '[ PERMISSION ERROR- '),
write(user_error, A/N), write(user_error, M:P/N),
write(user_error, ' is not declared as table ]'), write(user_error, ' is not tabled ]'),
nl(user_error), nl(user_error), fail
fail
). ).
'$resume_trie'(X,M) :- write(user_error, '[ Error: '), '$show_trie_stats'(P,_) :- '$do_error'(type_error(callable,P),show_trie_stats).
write(user_error, M:X),
write(user_error, ' is an invalid argument to trie/1 ]'),
nl(user_error),
fail.