bug fixes for YapTab support
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1259 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc
parent
b729ef2709
commit
4c972ca825
90
C/absmi.c
90
C/absmi.c
@ -10,8 +10,12 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* 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_at_least_one_arg(PREG->u.ld.s);
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -590,7 +594,7 @@ Yap_absmi(int inp)
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
restore_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
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
|
||||
* choicepoint */
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -657,7 +661,7 @@ Yap_absmi(int inp)
|
||||
restore_yaam_regs(PREG->u.ld.d);
|
||||
restore_args(PREG->u.ld.s);
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -676,7 +680,7 @@ Yap_absmi(int inp)
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
restore_args(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
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
|
||||
* choicepoint */
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -802,7 +806,7 @@ Yap_absmi(int inp)
|
||||
restore_yaam_regs(PREG->u.ld.d);
|
||||
restore_args(PREG->u.ld.s);
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -821,7 +825,7 @@ Yap_absmi(int inp)
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
restore_args(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
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
|
||||
* choicepoint */
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -884,7 +888,7 @@ Yap_absmi(int inp)
|
||||
CACHE_Y(B);
|
||||
restore_yaam_regs(PREG->u.ld.d);
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -902,7 +906,7 @@ Yap_absmi(int inp)
|
||||
if (SCH_top_shared_cp(B)) {
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
@ -912,7 +916,7 @@ Yap_absmi(int inp)
|
||||
pop_yaam_regs();
|
||||
S_YREG = (CELL *)(B_YREG+1);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -949,7 +953,7 @@ Yap_absmi(int inp)
|
||||
restore_yaam_regs(PREG->u.ld.d);
|
||||
ARG1 = B_YREG->cp_a1;
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -968,7 +972,7 @@ Yap_absmi(int inp)
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
ARG1 = B_YREG->cp_a1;
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
@ -979,7 +983,7 @@ Yap_absmi(int inp)
|
||||
ARG1 = B_YREG->cp_a1;
|
||||
S_YREG = &(B_YREG->cp_a2);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -1025,7 +1029,7 @@ Yap_absmi(int inp)
|
||||
ARG1 = B_YREG->cp_a1;
|
||||
ARG2 = B_YREG->cp_a2;
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -1045,7 +1049,7 @@ Yap_absmi(int inp)
|
||||
ARG1 = B_YREG->cp_a1;
|
||||
ARG2 = B_YREG->cp_a2;
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
@ -1057,7 +1061,7 @@ Yap_absmi(int inp)
|
||||
ARG2 = B_YREG->cp_a2;
|
||||
S_YREG = &(B_YREG->cp_a3);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -1107,7 +1111,7 @@ Yap_absmi(int inp)
|
||||
ARG2 = B_YREG->cp_a2;
|
||||
ARG3 = B_YREG->cp_a3;
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -1128,7 +1132,7 @@ Yap_absmi(int inp)
|
||||
ARG2 = B_YREG->cp_a2;
|
||||
ARG3 = B_YREG->cp_a3;
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
@ -1141,7 +1145,7 @@ Yap_absmi(int inp)
|
||||
ARG3 = B_YREG->cp_a3;
|
||||
S_YREG = &(B_YREG->cp_a4);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -1194,7 +1198,7 @@ Yap_absmi(int inp)
|
||||
ARG3 = B_YREG->cp_a3;
|
||||
ARG4 = B_YREG->cp_a4;
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -1216,7 +1220,7 @@ Yap_absmi(int inp)
|
||||
ARG3 = B_YREG->cp_a3;
|
||||
ARG4 = B_YREG->cp_a4;
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
@ -1230,7 +1234,7 @@ Yap_absmi(int inp)
|
||||
ARG4 = B_YREG->cp_a4;
|
||||
S_YREG = &(B_YREG->cp_a5);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
@ -1658,7 +1662,7 @@ Yap_absmi(int inp)
|
||||
restore_yaam_regs(PREG);
|
||||
restore_args(PREG->u.ld.s);
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -1722,17 +1726,6 @@ Yap_absmi(int inp)
|
||||
PREFETCH_OP(PREG);
|
||||
failloop:
|
||||
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;
|
||||
#ifdef LOW_LEVEL_TRACER
|
||||
if (Yap_do_low_level_trace) {
|
||||
@ -1837,6 +1830,17 @@ Yap_absmi(int inp)
|
||||
}
|
||||
}
|
||||
#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();
|
||||
GONext();
|
||||
}
|
||||
@ -7442,7 +7446,7 @@ Yap_absmi(int inp)
|
||||
restore_yaam_regs(NEXTOP(PREG, ld));
|
||||
restore_at_least_one_arg(PREG->u.ld.s);
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -7460,7 +7464,7 @@ Yap_absmi(int inp)
|
||||
ARG1 = B_YREG->cp_a1;
|
||||
ARG2 = B_YREG->cp_a2;
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -7478,7 +7482,7 @@ Yap_absmi(int inp)
|
||||
ARG2 = B_YREG->cp_a2;
|
||||
ARG3 = B_YREG->cp_a3;
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -7497,7 +7501,7 @@ Yap_absmi(int inp)
|
||||
ARG3 = B_YREG->cp_a3;
|
||||
ARG4 = B_YREG->cp_a4;
|
||||
#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);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
@ -7514,7 +7518,7 @@ Yap_absmi(int inp)
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
restore_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
@ -7524,7 +7528,7 @@ Yap_absmi(int inp)
|
||||
pop_yaam_regs();
|
||||
pop_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
|
||||
27
C/alloc.c
27
C/alloc.c
@ -12,7 +12,7 @@
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* 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
|
||||
static char SccsId[] = "%W% %G%";
|
||||
@ -466,7 +466,7 @@ AllocHeap(unsigned int size)
|
||||
|
||||
#ifdef YAPOR
|
||||
if (HeapTop > Addr(Yap_GlobalBase) - MinHeapGap) {
|
||||
abort_optyap("No heap left in function AllocHeap");
|
||||
abort_yapor("No heap left in function AllocHeap");
|
||||
}
|
||||
#else
|
||||
if (HeapTop > HeapLim - MinHeapGap) {
|
||||
@ -815,7 +815,7 @@ static int
|
||||
ExtendWorkSpace(Int s, int fixed_allocation)
|
||||
{
|
||||
#ifdef YAPOR
|
||||
abort_optyap("function ExtendWorkSpace called");
|
||||
abort_yapor("function ExtendWorkSpace called");
|
||||
return(FALSE);
|
||||
#else
|
||||
MALLOC_T a;
|
||||
@ -1266,14 +1266,6 @@ InitHeap(void *heap_addr)
|
||||
FreeBlocks = NIL;
|
||||
|
||||
#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 */
|
||||
#endif /* YAPOR || TABLING */
|
||||
}
|
||||
@ -1289,21 +1281,8 @@ Yap_InitMemory(int Trail, int Heap, int Stack)
|
||||
{
|
||||
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)
|
||||
Heap = MinHeapSpace;
|
||||
#endif /* YAPOR || TABLING */
|
||||
|
||||
/* sanity checking for data areas */
|
||||
if (Trail < MinTrailSpace)
|
||||
Trail = MinTrailSpace;
|
||||
|
||||
16
C/amasm.c
16
C/amasm.c
@ -11,8 +11,12 @@
|
||||
* File: amasm.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* some extra bug fixes for trail overflows: some cannot be recovered that easily,
|
||||
* 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))
|
||||
#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 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
|
||||
#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 */
|
||||
|
||||
static yamop *
|
||||
@ -2407,10 +2411,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
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;
|
||||
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;
|
||||
#endif /* TABLING */
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
@ -2706,7 +2710,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
}
|
||||
#ifdef TABLING
|
||||
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
|
||||
#endif
|
||||
code_p = a_gl(_trust, &clinfo, code_p, pass_no, cip->cpc);
|
||||
|
||||
@ -10,8 +10,12 @@
|
||||
* File: c_interface.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* fix pruning bug
|
||||
* make DL_MALLOC less enthusiastic about walking through buckets.
|
||||
@ -1151,7 +1155,7 @@ YAP_Init(YAP_init_args *yap_init)
|
||||
CurrentModule = USER_MODULE;
|
||||
P = GETWORK_FIRST_TIME;
|
||||
Yap_exec_absmi(FALSE);
|
||||
abort_optyap("abstract machine unexpected exit");
|
||||
abort_yapor("abstract machine unexpected exit");
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
#endif /* YAPOR || TABLING */
|
||||
|
||||
11
C/cdmgr.c
11
C/cdmgr.c
@ -11,8 +11,12 @@
|
||||
* File: cdmgr.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* library_directory may not be deterministic (usually it isn't).
|
||||
*
|
||||
@ -263,7 +267,8 @@ PredForChoicePt(yamop *p_code) {
|
||||
return NULL;
|
||||
case _table_completion:
|
||||
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
|
||||
case _or_else:
|
||||
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);
|
||||
}
|
||||
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 */
|
||||
#ifdef TABLING
|
||||
if (is_tabled(p)) {
|
||||
|
||||
21
C/compiler.c
21
C/compiler.c
@ -11,8 +11,12 @@
|
||||
* File: compiler.c *
|
||||
* 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 $
|
||||
* Revision 1.62 2005/02/21 16:49:39 vsc
|
||||
* amd64 fixes
|
||||
* library fixes
|
||||
*
|
||||
* Revision 1.61 2005/01/28 23:14:35 vsc
|
||||
* move to Yap-4.5.7
|
||||
* Fix clause size
|
||||
@ -1231,11 +1235,15 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
if (cglobs->onlast) {
|
||||
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
|
||||
#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);
|
||||
#ifdef TABLING
|
||||
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
|
||||
#endif
|
||||
}
|
||||
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 */
|
||||
c_head(head, &cglobs);
|
||||
if (cglobs.is_a_fact && !cglobs.vtable) {
|
||||
Yap_emit(procceed_op, Zero, Zero, &cglobs.cint);
|
||||
#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);
|
||||
#ifdef TABLING
|
||||
READ_UNLOCK(cglobs.cint.CurrentPred->PRWLock);
|
||||
#endif
|
||||
/* ground term, do not need much more work */
|
||||
if (cglobs.cint.BlobsStart != NULL) {
|
||||
cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart;
|
||||
|
||||
4
C/grow.c
4
C/grow.c
@ -757,6 +757,10 @@ fix_compiler_instructions(PInstr *pcpc)
|
||||
case enter_lu_op:
|
||||
case empty_call_op:
|
||||
case blob_op:
|
||||
#ifdef TABLING
|
||||
case table_new_answer_op:
|
||||
case table_try_single_op:
|
||||
#endif /* TABLING */
|
||||
break;
|
||||
}
|
||||
if (ncpc != NULL) {
|
||||
|
||||
@ -11,8 +11,12 @@
|
||||
* File: index.c *
|
||||
* 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 $
|
||||
* 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
|
||||
* 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)
|
||||
{
|
||||
#ifdef TABLING
|
||||
if (ap->PredFlags & TabledPredFlag) {
|
||||
if (cint->CurrentPred->PredFlags & TabledPredFlag) {
|
||||
/* we have two differences with tabling:
|
||||
1. we cannot allow straight jumps to clauses, otherwise thetabled
|
||||
would never get to be created.
|
||||
|
||||
112
C/init.c
112
C/init.c
@ -1122,79 +1122,6 @@ InitVersion(void)
|
||||
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
|
||||
Yap_InitWorkspace(int Heap,
|
||||
@ -1228,18 +1155,35 @@ Yap_InitWorkspace(int Heap,
|
||||
/* also init memory page size, required by later functions */
|
||||
Yap_InitSysbits ();
|
||||
|
||||
#if defined(YAPOR) || defined(TABLING)
|
||||
InitYapOr(Heap,
|
||||
Stack,
|
||||
Trail,
|
||||
aux_number_workers,
|
||||
aux_scheduler_loop,
|
||||
aux_delayed_release_load);
|
||||
#else /* Yap */
|
||||
Yap_InitMemory (Trail, Heap, Stack);
|
||||
#endif /* YAPOR || TABLING */
|
||||
Yap_InitTime ();
|
||||
#ifdef TABLING
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
INFORMATION_MESSAGE("YapTab: batched scheduling");
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
INFORMATION_MESSAGE("YapTab: local scheduling");
|
||||
#endif /* BATCHED - LOCAL */
|
||||
#endif /* TABLING */
|
||||
|
||||
#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;
|
||||
HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
|
||||
if (HashChain == NULL) {
|
||||
|
||||
26
C/save.c
26
C/save.c
@ -468,18 +468,9 @@ save_heap(void)
|
||||
j = Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase);
|
||||
putout(j);
|
||||
mywrite(splfild, (char *) Yap_HeapBase, j);
|
||||
#ifdef USE_HEAP
|
||||
j = Unsigned(HeapTop) - Unsigned(&HashChain);
|
||||
putout(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
|
||||
j = Unsigned(HeapTop) - Unsigned(Yap_HeapBase);
|
||||
/* store 10 more cells because of the memory manager */
|
||||
@ -888,28 +879,11 @@ CopyCode(void)
|
||||
}
|
||||
if (myread(splfild, (char *) Yap_HeapBase, j) < 0)
|
||||
return -1;
|
||||
#ifdef USE_HEAP
|
||||
j = get_cell();
|
||||
if (Yap_ErrorMessage)
|
||||
return -1;
|
||||
if (myread(splfild, (char *) &HashChain, j) < 0)
|
||||
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
|
||||
if (myread(splfild, (char *) Yap_HeapBase,
|
||||
(Unsigned(OldHeapTop) - Unsigned(OldHeapBase))) < 0)
|
||||
|
||||
@ -10,8 +10,8 @@
|
||||
#define TG_ANSWER_SLOTS 20
|
||||
|
||||
|
||||
#define STATISTICS 1
|
||||
/*
|
||||
#define STATISTICS 1
|
||||
#define YAPOR_ERRORS 1
|
||||
#define TABLING_ERRORS 1
|
||||
*/
|
||||
@ -43,7 +43,6 @@
|
||||
#define TIMESTAMP_CHECK 1
|
||||
|
||||
|
||||
#define USE_HEAP 1 /* use heap instead of special areas for memory allocation */
|
||||
|
||||
|
||||
|
||||
|
||||
@ -41,14 +41,6 @@ ma_h_inner_struct *ma_h_top;
|
||||
|
||||
|
||||
|
||||
/* ------------------------------------- **
|
||||
** Local functions declaration **
|
||||
** ------------------------------------- */
|
||||
|
||||
static void receive_signals(int s);
|
||||
|
||||
|
||||
|
||||
/* ---------------------- **
|
||||
** Local macros **
|
||||
** ---------------------- */
|
||||
@ -234,7 +226,7 @@ void init_workers(void) {
|
||||
if (number_workers > 1) {
|
||||
int son;
|
||||
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) {
|
||||
/* I am the father, I must stay here and wait for my children to all die */
|
||||
struct sigaction sigact;
|
||||
@ -252,7 +244,7 @@ void init_workers(void) {
|
||||
for (proc = 1; proc < number_workers; proc++) {
|
||||
int son;
|
||||
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) {
|
||||
/* new worker */
|
||||
worker_id = proc;
|
||||
@ -263,32 +255,4 @@ void init_workers(void) {
|
||||
}
|
||||
}
|
||||
#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 */
|
||||
|
||||
@ -35,40 +35,29 @@ extern int Yap_page_size;
|
||||
|
||||
|
||||
|
||||
#define ALLOC_BLOCK(BLOCK, SIZE) \
|
||||
BLOCK = (void *) Yap_AllocAtomSpace(SIZE)
|
||||
#define FREE_BLOCK(BLOCK) \
|
||||
#define ALLOC_BLOCK(BLOCK, 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) \
|
||||
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) \
|
||||
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
|
||||
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \
|
||||
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \
|
||||
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
|
||||
if (TopAllocArea == TopWorkArea) \
|
||||
abort_optyap("no more free alloc space (ALLOC_PAGE)"); \
|
||||
ALLOC_BLOCK(PG_HD, Yap_page_size); \
|
||||
UPDATE_STATS(Pg_str_alloc(GLOBAL_PAGES_void), 1); \
|
||||
PG_HD = (pg_hd_ptr)TopAllocArea; \
|
||||
TopAllocArea += Yap_page_size \
|
||||
} else { \
|
||||
PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \
|
||||
Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \
|
||||
@ -184,8 +173,16 @@ extern int Yap_page_size;
|
||||
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 FREE_OR_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_or_fr, struct or_frame)
|
||||
|
||||
@ -60,11 +60,11 @@ int shm_mapid[MAX_WORKERS + 1];
|
||||
void shm_map_memory(int id, int size, void *shmaddr) {
|
||||
#define SHMMAX 0x2000000 /* as in <asm/shmparam.h> */
|
||||
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)
|
||||
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)
|
||||
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;
|
||||
}
|
||||
#else /* MMAP_MEMORY_MAPPING_SCHEME */
|
||||
@ -73,18 +73,18 @@ open_mapfile(long TotalArea) {
|
||||
strcpy(mapfile,"/tmp/mapfile");
|
||||
itos(getpid(), &mapfile[12]);
|
||||
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)
|
||||
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)
|
||||
abort_optyap("write error in function open_mapfile: %s", strerror(errno));
|
||||
abort_yapor("write error in function open_mapfile: %s", strerror(errno));
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
close_mapfile(void) {
|
||||
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 */
|
||||
|
||||
@ -129,7 +129,7 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
|
||||
open_mapfile(TotalArea);
|
||||
if ((mmap_addr = mmap((void *) MMAP_ADDR, (size_t) TotalArea, PROT_READ|PROT_WRITE,
|
||||
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 */
|
||||
/* Most systems are limited regarding what we can allocate */
|
||||
#ifdef ACOW
|
||||
@ -144,10 +144,10 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
|
||||
#ifdef ACOW
|
||||
/* just allocate local space for stacks */
|
||||
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,
|
||||
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);
|
||||
#else /* ENV_COPY || SBA */
|
||||
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 */
|
||||
sba_size = WorkerArea * n_workers;
|
||||
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) {
|
||||
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_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_LocalBase = Yap_TrailBase - CellSize;
|
||||
|
||||
|
||||
if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */
|
||||
Yap_TrailTop = Yap_TrailBase + TrailAuxArea - 131072; /* 131072 = 262144 / 2 */
|
||||
else
|
||||
Yap_TrailTop = Yap_TrailBase + TrailAuxArea / 2;
|
||||
|
||||
|
||||
HeapMax = Yap_TrailBase + TrailAuxArea - CellSize;
|
||||
Yap_InitHeap(mmap_addr);
|
||||
BaseWorkArea = mmap_addr;
|
||||
|
||||
}
|
||||
|
||||
|
||||
@ -261,26 +257,26 @@ void remap_memory(void) {
|
||||
int i;
|
||||
|
||||
remap_addr = worker_area(0);
|
||||
remap_offset = remap_addr - BaseWorkArea;
|
||||
remap_offset = remap_addr - Yap_HeapBase;
|
||||
WorkerArea = worker_offset(1);
|
||||
#ifdef SHM_MEMORY_MAPPING_SCHEME
|
||||
for (i = 0; i < number_workers; i++) {
|
||||
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++) {
|
||||
worker_area(i) = remap_addr + ((number_workers + i - worker_id) % number_workers) * WorkerArea;
|
||||
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 */
|
||||
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++) {
|
||||
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,
|
||||
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 */
|
||||
for (i = 0; i < number_workers; i++) {
|
||||
|
||||
@ -33,23 +33,29 @@ struct worker WORKER;
|
||||
** Global functions **
|
||||
** -------------------------- */
|
||||
|
||||
void abort_optyap(const char *msg, ...) {
|
||||
#ifdef TABLING
|
||||
void abort_yaptab(const char *msg, ...) {
|
||||
va_list args;
|
||||
|
||||
va_start(args, msg);
|
||||
fprintf(stderr, "[ ");
|
||||
#ifdef YAPOR
|
||||
fprintf (stderr, "Worker %d ", worker_id);
|
||||
#endif /* YAPOR */
|
||||
fprintf (stderr, "Aborting OPTYap -> ");
|
||||
fprintf(stderr, "[ Fatal YapTab Error: ");
|
||||
vfprintf(stderr, msg, args);
|
||||
fprintf(stderr, " ]\n");
|
||||
|
||||
#ifdef YAPOR
|
||||
unmap_memory();
|
||||
#endif /* YAPOR */
|
||||
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) {
|
||||
|
||||
@ -53,10 +53,10 @@ static void answer_to_stdout(char *answer);
|
||||
static int p_table(void);
|
||||
static int p_abolish_trie(void);
|
||||
static int p_show_trie(void);
|
||||
static int p_resume_trie(void);
|
||||
static int p_show_trie_stats(void);
|
||||
#endif /* TABLING */
|
||||
#ifdef STATISTICS
|
||||
static int p_show_frames(void);
|
||||
static int p_show_frames_stats(void);
|
||||
#endif /* STATISTICS */
|
||||
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
|
||||
static int p_debug_prolog(void);
|
||||
@ -82,11 +82,11 @@ void Yap_init_optyap_preds(void) {
|
||||
#ifdef TABLING
|
||||
Yap_InitCPred("$do_table", 2, p_table, 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("$resume_trie", 2, p_resume_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_show_trie", 2, p_show_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_show_trie_stats", 2, p_show_trie_stats, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
#endif /* TABLING */
|
||||
#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 */
|
||||
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
|
||||
Yap_InitCPred("debug_prolog", 1, p_debug_prolog, SafePredFlag|SyncPredFlag);
|
||||
@ -449,7 +449,7 @@ int p_table(void) {
|
||||
tab_ent_ptr te;
|
||||
sg_node_ptr sg_node;
|
||||
|
||||
tmod = Deref(ARG2);
|
||||
mod = Deref(ARG2);
|
||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||
return (FALSE);
|
||||
}
|
||||
@ -480,7 +480,7 @@ int p_abolish_trie(void) {
|
||||
UInt arity;
|
||||
|
||||
mod = Deref(ARG2);
|
||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||
return (FALSE);
|
||||
}
|
||||
t = Deref(ARG1);
|
||||
@ -509,13 +509,13 @@ int p_abolish_trie(void) {
|
||||
|
||||
static
|
||||
int p_show_trie(void) {
|
||||
Term t1, t2, mod;
|
||||
Term t1, mod;
|
||||
PredEntry *pe;
|
||||
Atom at;
|
||||
UInt arity;
|
||||
|
||||
mod = Deref(ARG2);
|
||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||
return (FALSE);
|
||||
}
|
||||
t1 = Deref(ARG1);
|
||||
@ -531,31 +531,17 @@ int p_show_trie(void) {
|
||||
} else {
|
||||
return (FALSE);
|
||||
}
|
||||
t2 = Deref(ARG3);
|
||||
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);
|
||||
}
|
||||
traverse_trie(stdout, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
|
||||
return (TRUE);
|
||||
}
|
||||
|
||||
|
||||
static
|
||||
int p_resume_trie(void) {
|
||||
int p_show_trie_stats(void) {
|
||||
Term t, mod;
|
||||
PredEntry *pe;
|
||||
Atom at;
|
||||
int arity;
|
||||
UInt arity;
|
||||
|
||||
mod = Deref(ARG2);
|
||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||
@ -582,7 +568,7 @@ int p_resume_trie(void) {
|
||||
|
||||
#ifdef STATISTICS
|
||||
static
|
||||
int p_show_frames(void) {
|
||||
int p_show_frames_stats(void) {
|
||||
long cont, pages;
|
||||
pg_hd_ptr pg_hd;
|
||||
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",
|
||||
(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_alloc(GLOBAL_PAGES_void),
|
||||
Pg_str_in_use(GLOBAL_PAGES_void), cont, Pg_requests(GLOBAL_PAGES_void));
|
||||
|
||||
@ -23,7 +23,12 @@ void remap_memory(void);
|
||||
** 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 information_message(const char *mesg,...);
|
||||
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
|
||||
@ -41,7 +46,6 @@ void make_root_frames(void);
|
||||
#ifdef YAPOR
|
||||
void init_workers(void);
|
||||
#endif /* YAPOR */
|
||||
void init_signals(void);
|
||||
|
||||
|
||||
/* ------------- **
|
||||
|
||||
@ -117,9 +117,6 @@ struct global_locks {
|
||||
|
||||
struct global_data{
|
||||
/* global data related to memory management */
|
||||
void *BaseWorkArea;
|
||||
void *BaseAllocArea;
|
||||
void *TopAllocArea;
|
||||
struct global_pages pages;
|
||||
|
||||
#ifdef YAPOR
|
||||
@ -170,10 +167,6 @@ struct global_data{
|
||||
#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_or_fr (GLOBAL.pages.or_frame_pages)
|
||||
#define GLOBAL_PAGES_qg_sol_fr (GLOBAL.pages.query_goal_solution_frame_pages)
|
||||
|
||||
@ -187,7 +187,7 @@ void share_private_nodes(int worker_q) {
|
||||
}
|
||||
/* update 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;
|
||||
while (or_frame != LOCAL_top_or_fr) {
|
||||
unsigned int branch;
|
||||
|
||||
@ -575,7 +575,7 @@ void share_private_nodes(int worker_q) {
|
||||
|
||||
/* update 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;
|
||||
#ifdef TABLING
|
||||
previous_or_frame = LOCAL_top_cp_on_stack->cp_or_fr;
|
||||
|
||||
@ -251,7 +251,7 @@ void share_private_nodes(int worker_q) {
|
||||
}
|
||||
/* update 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;
|
||||
|
||||
while (or_frame != LOCAL_top_or_fr) {
|
||||
|
||||
@ -21,19 +21,20 @@
|
||||
#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 gen_cp_ptr gcp; \
|
||||
/* store args */ \
|
||||
pt_args = XREGS + (ARITY); \
|
||||
while (pt_args > XREGS) { \
|
||||
register CELL aux_arg = pt_args[0]; \
|
||||
--PTR; \
|
||||
--YENV; \
|
||||
--pt_args; \
|
||||
*PTR = aux_arg; \
|
||||
*YENV = aux_arg; \
|
||||
} \
|
||||
/* 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); \
|
||||
/* store generator choice point */ \
|
||||
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 gen_cp_ptr gcp = GEN_CP(PTR); \
|
||||
register gen_cp_ptr gcp = GEN_CP(B); \
|
||||
/* restore generator choice point */ \
|
||||
H = HBREG = PROTECT_FROZEN_H(NORM_CP(gcp)); \
|
||||
CPREG = gcp->gcp_cp; \
|
||||
@ -72,35 +73,36 @@
|
||||
}
|
||||
|
||||
|
||||
#define pop_generator_node(PTR, ARITY) \
|
||||
{ register CELL *pt_args, *x_args; \
|
||||
register gen_cp_ptr gcp = GEN_CP(PTR); \
|
||||
/* pop generator choice point */ \
|
||||
H = PROTECT_FROZEN_H(NORM_CP(gcp)); \
|
||||
CPREG = gcp->gcp_cp; \
|
||||
ENV = gcp->gcp_env; \
|
||||
TR = B->cp_tr; \
|
||||
B = gcp->gcp_b; \
|
||||
HBREG = PROTECT_FROZEN_H(B); \
|
||||
/* pop args */ \
|
||||
x_args = XREGS + 1 ; \
|
||||
pt_args = (CELL *)(gcp + 1); \
|
||||
while (x_args < XREGS + 1 + ARITY) { \
|
||||
register CELL x = pt_args[0]; \
|
||||
pt_args++; \
|
||||
x_args++; \
|
||||
x_args[-1] = x; \
|
||||
} \
|
||||
YENV = pt_args; \
|
||||
SET_BB(PROTECT_FROZEN_B(B)); \
|
||||
#define pop_generator_node(ARITY) \
|
||||
{ register CELL *pt_args, *x_args; \
|
||||
register gen_cp_ptr gcp = GEN_CP(B); \
|
||||
/* pop generator choice point */ \
|
||||
H = PROTECT_FROZEN_H(NORM_CP(gcp)); \
|
||||
CPREG = gcp->gcp_cp; \
|
||||
ENV = gcp->gcp_env; \
|
||||
TR = B->cp_tr; \
|
||||
B = gcp->gcp_b; \
|
||||
HBREG = PROTECT_FROZEN_H(B); \
|
||||
/* pop args */ \
|
||||
x_args = XREGS + 1 ; \
|
||||
pt_args = (CELL *)(gcp + 1); \
|
||||
while (x_args < XREGS + 1 + ARITY) { \
|
||||
register CELL x = pt_args[0]; \
|
||||
pt_args++; \
|
||||
x_args++; \
|
||||
x_args[-1] = x; \
|
||||
} \
|
||||
YENV = pt_args; \
|
||||
SET_BB(PROTECT_FROZEN_B(B)); \
|
||||
}
|
||||
|
||||
|
||||
#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 dep_fr_ptr new_dep_fr; \
|
||||
/* initialize ccp */ \
|
||||
ccp = --CONS_CP(PTR); \
|
||||
YENV = (CELL *) (CONS_CP(YENV) - 1); \
|
||||
ccp = CONS_CP(YENV); \
|
||||
/* adjust freeze registers */ \
|
||||
H_FZ = H; \
|
||||
B_FZ = NORM_CP(ccp); \
|
||||
@ -175,6 +177,7 @@
|
||||
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
Op(clause_with_cut, e)
|
||||
/*printf("estou aqui - clause_with_cut\n");*/
|
||||
if (LOCAL_pruning_scope) {
|
||||
if (YOUNGER_CP(LOCAL_pruning_scope, B))
|
||||
LOCAL_pruning_scope = B;
|
||||
@ -195,6 +198,7 @@
|
||||
sg_fr_ptr sg_fr;
|
||||
CELL *Yaddr;
|
||||
|
||||
/*printf("estou aqui - table_try_single\n");*/
|
||||
Yaddr = YENV;
|
||||
check_trail();
|
||||
tab_ent = PREG->u.ld.te;
|
||||
@ -220,7 +224,7 @@
|
||||
UNLOCK_TABLE(sg_node);
|
||||
#endif /* TABLE_LOCK_LEVEL */
|
||||
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;
|
||||
PREFETCH_OP(PREG);
|
||||
allocate_environment(YENV);
|
||||
@ -265,7 +269,7 @@
|
||||
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
|
||||
UNLOCK(SgFr_lock(sg_fr));
|
||||
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
|
||||
if (PARALLEL_EXECUTION_MODE) {
|
||||
choiceptr aux_cp;
|
||||
@ -294,6 +298,7 @@
|
||||
sg_fr_ptr sg_fr;
|
||||
CELL *Yaddr;
|
||||
|
||||
/*printf("estou aqui - table_try_me\n");*/
|
||||
Yaddr = YENV;
|
||||
check_trail();
|
||||
tab_ent = PREG->u.ld.te;
|
||||
@ -319,7 +324,7 @@
|
||||
UNLOCK_TABLE(sg_node);
|
||||
#endif /* TABLE_LOCK_LEVEL */
|
||||
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);
|
||||
PREFETCH_OP(PREG);
|
||||
allocate_environment(YENV);
|
||||
@ -364,7 +369,7 @@
|
||||
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
|
||||
UNLOCK(SgFr_lock(sg_fr));
|
||||
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
|
||||
if (PARALLEL_EXECUTION_MODE) {
|
||||
choiceptr aux_cp;
|
||||
@ -392,6 +397,7 @@
|
||||
sg_fr_ptr sg_fr;
|
||||
CELL *Yaddr;
|
||||
|
||||
/*printf("estou aqui - table_try\n");*/
|
||||
Yaddr = YENV;
|
||||
check_trail();
|
||||
tab_ent = PREG->u.ld.te;
|
||||
@ -417,7 +423,7 @@
|
||||
UNLOCK_TABLE(sg_node);
|
||||
#endif /* TABLE_LOCK_LEVEL */
|
||||
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;
|
||||
PREFETCH_OP(PREG);
|
||||
allocate_environment(YENV);
|
||||
@ -462,7 +468,7 @@
|
||||
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
|
||||
UNLOCK(SgFr_lock(sg_fr));
|
||||
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
|
||||
if (PARALLEL_EXECUTION_MODE) {
|
||||
choiceptr aux_cp;
|
||||
@ -486,7 +492,8 @@
|
||||
|
||||
|
||||
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);
|
||||
set_cut(YENV, B->cp_b);
|
||||
SET_BB(NORM_CP(YENV));
|
||||
@ -497,7 +504,8 @@
|
||||
|
||||
|
||||
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);
|
||||
set_cut(YENV, B->cp_b);
|
||||
SET_BB(NORM_CP(YENV));
|
||||
@ -509,7 +517,8 @@
|
||||
|
||||
|
||||
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);
|
||||
set_cut(YENV, B->cp_b);
|
||||
SET_BB(NORM_CP(YENV));
|
||||
@ -519,7 +528,8 @@
|
||||
ENDOp();
|
||||
|
||||
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);
|
||||
set_cut(YENV, B->cp_b);
|
||||
SET_BB(NORM_CP(YENV));
|
||||
@ -535,6 +545,7 @@
|
||||
sg_fr_ptr sg_fr;
|
||||
ans_node_ptr ans_node;
|
||||
|
||||
/*printf("estou aqui - table_new_answer\n");*/
|
||||
/* possible optimization: when the number of substitution variables **
|
||||
** is zero, an answer is sufficient to perform an early completion */
|
||||
gcp = GEN_CP(YENV[E_B]);
|
||||
@ -755,6 +766,7 @@
|
||||
|
||||
|
||||
BOp(table_answer_resolution, ld)
|
||||
/*printf("estou aqui - table_answer_resolution\n");*/
|
||||
#ifdef YAPOR
|
||||
if (SCH_top_shared_cp(B)) {
|
||||
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
|
||||
@ -1046,6 +1058,7 @@
|
||||
|
||||
|
||||
BOp(table_completion, ld);
|
||||
/*printf("estou aqui - table_completion\n");*/
|
||||
#ifdef YAPOR
|
||||
if (SCH_top_shared_cp(B)) {
|
||||
SCH_new_alternative(PREG, GEN_CP_NULL_ALT);
|
||||
@ -1070,7 +1083,7 @@
|
||||
|
||||
|
||||
completion:
|
||||
|
||||
/*printf("estou aqui - completion\n");*/
|
||||
|
||||
INIT_PREFETCH()
|
||||
dep_fr_ptr dep_fr;
|
||||
@ -1361,7 +1374,7 @@
|
||||
TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (completion)");
|
||||
}
|
||||
#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)) {
|
||||
/* yes answer --> procceed */
|
||||
PREG = (yamop *) CPREG;
|
||||
|
||||
@ -67,35 +67,34 @@ 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 CONS_CP(CP) ((cons_cp_ptr)(CP))
|
||||
|
||||
|
||||
#define TAG_AS_ANSWER_LEAF_NODE(NODE) ((unsigned int)TrNode_parent(NODE) |= 0x1)
|
||||
#define TAG_AS_ANSWER_LEAF_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((unsigned int)TrNode_parent(NODE) | 0x1)
|
||||
#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 FREE_STACK_PUSH(ITEM, STACK) *--STACK = (CELL)(ITEM)
|
||||
#define STACK_TOP(STACK) *STACK
|
||||
#define STACK_POP(STACK) *STACK++
|
||||
#define STACK_EMPTY(STACK, STACK_BASE) STACK == STACK_BASE
|
||||
#define STACK_NOT_EMPTY(STACK, STACK_BASE) STACK != STACK_BASE
|
||||
#ifdef YAPOR
|
||||
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
|
||||
*--STACK = (CELL)(ITEM); \
|
||||
if (STACK <= STACK_TOP) \
|
||||
abort_optyap("auxiliary stack full")
|
||||
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
|
||||
*--STACK = (CELL)(ITEM); \
|
||||
if (STACK <= STACK_TOP) \
|
||||
abort_yapor("auxiliary stack full")
|
||||
#else
|
||||
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
|
||||
*--(STACK) = (CELL)(ITEM); \
|
||||
if ((STACK) <= STACK_TOP + 1024) { \
|
||||
CELL *NEW_STACK; \
|
||||
UInt diff; \
|
||||
char *OldTrailTop = (char *)Yap_TrailTop; \
|
||||
Yap_growtrail(64 * 1024L); \
|
||||
diff = (char *)Yap_TrailTop - OldTrailTop; \
|
||||
NEW_STACK = (CELL *)((char *)(STACK)+diff); \
|
||||
memmove((void *)NEW_STACK, (void *)(STACK), (char *)OldTrailTop-(char *)STACK); \
|
||||
(STACK) = NEW_STACK; \
|
||||
(STACK_BASE) = (CELL *)((char *)(STACK_BASE)+diff); \
|
||||
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
|
||||
*--(STACK) = (CELL)(ITEM); \
|
||||
if ((STACK) <= STACK_TOP + 1024) { \
|
||||
void *old_top = Yap_TrailTop; \
|
||||
CELL *NEW_STACK; \
|
||||
UInt diff; \
|
||||
abort_yaptab("auxiliary stack full"); \
|
||||
Yap_growtrail(64 * 1024L, TRUE); \
|
||||
diff = (void *)Yap_TrailTop - old_top; \
|
||||
NEW_STACK = (CELL *)((void *)(STACK) + diff); \
|
||||
memmove((void *)NEW_STACK, (void *)(STACK), old_top - (void *)STACK); \
|
||||
(STACK) = NEW_STACK; \
|
||||
(STACK_BASE) = (CELL *)((void *)(STACK_BASE) + diff); \
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
|
||||
@ -494,7 +493,7 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
|
||||
|
||||
static inline
|
||||
void pruning_over_tabling_data_structures(void) {
|
||||
abort_optyap("pruning over tabling data structures");
|
||||
abort_yaptab("pruning over tabling data structures");
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
@ -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);
|
||||
break;
|
||||
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));
|
||||
}
|
||||
@ -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);
|
||||
break;
|
||||
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));
|
||||
}
|
||||
@ -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);
|
||||
} break;
|
||||
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)) {
|
||||
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);
|
||||
} break;
|
||||
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));
|
||||
break;
|
||||
default:
|
||||
abort_optyap("unknown type tag in function chain_subgoal_frames");
|
||||
abort_yaptab("unknown type tag in function chain_subgoal_frames");
|
||||
}
|
||||
if (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));
|
||||
break;
|
||||
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))
|
||||
@ -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));
|
||||
break;
|
||||
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)) {
|
||||
|
||||
@ -47,7 +47,7 @@
|
||||
} else { \
|
||||
/* procceed */ \
|
||||
PREG = (yamop *) CPREG; \
|
||||
YENV = ENV; \
|
||||
YENV = ENV; \
|
||||
} \
|
||||
PREFETCH_OP(PREG); \
|
||||
GONext()
|
||||
@ -60,19 +60,20 @@
|
||||
** macro because there are no cuts in trie instructions. **
|
||||
** -------------------------------------------------------------- */
|
||||
|
||||
#define store_trie_choice_point(PTR, AP) \
|
||||
{ register choiceptr cp; \
|
||||
cp = --NORM_CP(PTR); \
|
||||
HBREG = H; \
|
||||
cp->cp_tr = TR; \
|
||||
cp->cp_h = H; \
|
||||
cp->cp_b = B; \
|
||||
cp->cp_cp = CPREG; \
|
||||
cp->cp_ap = (yamop *) AP; \
|
||||
cp->cp_env= ENV; \
|
||||
B = cp; \
|
||||
YAPOR_SET_LOAD(B); \
|
||||
SET_BB(B); \
|
||||
#define store_trie_choice_point(AP) \
|
||||
{ register choiceptr cp; \
|
||||
YENV = (CELL *) (NORM_CP(YENV) - 1); \
|
||||
cp = NORM_CP(YENV); \
|
||||
HBREG = H; \
|
||||
cp->cp_tr = TR; \
|
||||
cp->cp_h = H; \
|
||||
cp->cp_b = B; \
|
||||
cp->cp_cp = CPREG; \
|
||||
cp->cp_ap = (yamop *) AP; \
|
||||
cp->cp_env= ENV; \
|
||||
B = cp; \
|
||||
YAPOR_SET_LOAD(B); \
|
||||
SET_BB(B); \
|
||||
}
|
||||
|
||||
|
||||
@ -451,7 +452,7 @@
|
||||
int subs_arity = *(aux_ptr + heap_arity + 2);
|
||||
int i;
|
||||
|
||||
store_trie_choice_point(YENV, TrNode_next(node));
|
||||
store_trie_choice_point(TrNode_next(node));
|
||||
cp_trie_var_instr();
|
||||
ENDPBOp();
|
||||
|
||||
@ -520,7 +521,7 @@
|
||||
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
|
||||
int i;
|
||||
|
||||
store_trie_choice_point(YENV, TrNode_next(node));
|
||||
store_trie_choice_point(TrNode_next(node));
|
||||
cp_trie_val_instr();
|
||||
ENDPBOp();
|
||||
|
||||
@ -587,7 +588,7 @@
|
||||
int subs_arity = *(aux_ptr + heap_arity + 2);
|
||||
int i;
|
||||
|
||||
store_trie_choice_point(YENV, TrNode_next(node));
|
||||
store_trie_choice_point(TrNode_next(node));
|
||||
cp_trie_atom_instr();
|
||||
ENDPBOp();
|
||||
|
||||
@ -650,7 +651,7 @@
|
||||
int subs_arity = *(aux_ptr + heap_arity + 2);
|
||||
int i;
|
||||
|
||||
store_trie_choice_point(YENV, TrNode_next(node));
|
||||
store_trie_choice_point(TrNode_next(node));
|
||||
cp_trie_list_instr();
|
||||
ENDPBOp();
|
||||
|
||||
@ -717,7 +718,7 @@
|
||||
int func_arity = ArityOfFunctor(func);
|
||||
int i;
|
||||
|
||||
store_trie_choice_point(YENV, TrNode_next(node));
|
||||
store_trie_choice_point(TrNode_next(node));
|
||||
cp_trie_struct_instr();
|
||||
ENDPBOp();
|
||||
|
||||
|
||||
165
pl/tabling.yap
165
pl/tabling.yap
@ -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'(X, M).
|
||||
table(X) :-
|
||||
'$current_module'(M),
|
||||
'$table'(X, M).
|
||||
table(M:P) :- !, '$table'(P,M).
|
||||
table(P) :- '$current_module'(M), '$table'(P,M).
|
||||
|
||||
'$table'(X, _) :- var(X), !,
|
||||
write(user_error, '[ Error: argument to table/1 should be a predicate ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
'$table'(M:A, _) :- !, '$table'(A, M).
|
||||
'$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.
|
||||
'$table'(P,M) :- var(P), !, '$do_error'(instantiation_error,table).
|
||||
'$table'((P1,P2),M) :- !, '$table'(P1,M), '$table'(P2,M).
|
||||
'$table'(P/N,M) :- integer(N), atom(P), !,
|
||||
functor(T,P,N), '$declare_tabled'(T,M).
|
||||
'$table'(P,M) :- '$do_error'(type_error(callable,P),table).
|
||||
|
||||
'$declare_tabled'(P, M) :-
|
||||
'$undefined'(P, M), !,
|
||||
'$do_table'(P, M).
|
||||
'$declare_tabled'(P, M) :-
|
||||
'$flags'(P,M,F,F),
|
||||
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)).
|
||||
'$declare_tabled'(T,M) :- '$undefined'(T,M), !, '$do_table'(T,M).
|
||||
'$declare_tabled'(T,M) :- '$flags'(T,M,F,F),
|
||||
X is F /\ 0x1991F880, X =:= 0, !, '$do_table'(T,M).
|
||||
'$declare_tabled'(T,M) :- functor(T,A,N),
|
||||
'$do_error'(permission_error(modify,static_procedure,A/N),tabled(M:A/N)).
|
||||
|
||||
abolish_trie(M:X) :- !,
|
||||
'$abolish_trie'(X, M).
|
||||
abolish_trie(X) :-
|
||||
'$current_module'(M),
|
||||
'$abolish_trie'(X, M).
|
||||
abolish_trie(M:P) :- !, '$abolish_trie'(P,M).
|
||||
abolish_trie(P) :- '$current_module'(M), '$abolish_trie'(P,M).
|
||||
|
||||
'$abolish_trie'(X, _M) :- var(X), !,
|
||||
write(user_error, '[ Error: argument to abolish_trie/1 should be a predicate ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
'$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)
|
||||
;
|
||||
write(user_error, '[ Error: '),
|
||||
write(user_error, M:A/N),
|
||||
write(user_error, ' is not declared as table ]'),
|
||||
nl(user_error),
|
||||
fail
|
||||
).
|
||||
'$abolish_trie'(X,M) :- write(user_error, '[ Error: '),
|
||||
write(user_error, M:X),
|
||||
write(user_error, ' is an invalid argument to abolish_trie/1 ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
'$abolish_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,abolish_trie).
|
||||
'$abolish_trie'((P1,P2),M) :- !, '$abolish_trie'(P1,M), '$abolish_trie'(P2,M).
|
||||
'$abolish_trie'(P/N,M) :- integer(N), atom(P), !,
|
||||
functor(T,P,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 0x000040, X =\= 0, !, '$do_abolish_trie'(T,M)
|
||||
;
|
||||
write(user_error, '[ PERMISSION ERROR- '),
|
||||
write(user_error, M:P/N),
|
||||
write(user_error, ' is not tabled ]'),
|
||||
nl(user_error), fail
|
||||
).
|
||||
'$abolish_trie'(P,_) :- '$do_error'(type_error(callable,P),abolish_trie).
|
||||
|
||||
show_trie(M:X) :- !,
|
||||
'$show_trie'(X, M).
|
||||
show_trie(X) :-
|
||||
'$current_module'(M),
|
||||
'$show_trie'(X, M).
|
||||
show_trie(M:P) :- !, '$show_trie'(P,M).
|
||||
show_trie(P) :- '$current_module'(M), '$show_trie'(P,M).
|
||||
|
||||
'$show_trie'(X, M) :- var(X), !,
|
||||
'$do_error'(instantiation_error,show_trie(M:X)).
|
||||
'$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M).
|
||||
'$show_trie'(M:A, _) :- !, '$show_trie'(A, M).
|
||||
'$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,_)
|
||||
;
|
||||
write(user_error, '[ Error: '),
|
||||
write(user_error, M:A/N),
|
||||
write(user_error, ' is not declared as table ]'),
|
||||
nl(user_error),
|
||||
fail
|
||||
).
|
||||
'$show_trie'(X, M) :- write(user_error, '[ Error: '),
|
||||
write(user_error, M:X),
|
||||
write(user_error, ' is an invalid argument to trie/1 ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
'$show_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie).
|
||||
'$show_trie'((P1,P2),M) :- !, '$show_trie'(P1,M), '$show_trie'(P2,M).
|
||||
'$show_trie'(P/N, M) :- integer(N), atom(P), !,
|
||||
functor(T,P,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 0x000040, X =\= 0, !, '$do_show_trie'(T,M)
|
||||
;
|
||||
write(user_error, '[ PERMISSION ERROR- '),
|
||||
write(user_error, M:P/N),
|
||||
write(user_error, ' is not tabled ]'),
|
||||
nl(user_error), fail
|
||||
).
|
||||
'$show_trie'(P,_) :- '$do_error'(type_error(callable,P),show_trie).
|
||||
|
||||
resume_trie(M:X) :- !,
|
||||
'$resume_trie'(X, M).
|
||||
resume_trie(X) :-
|
||||
'$current_module'(M),
|
||||
'$resume_trie'(X, M).
|
||||
show_trie_stats(M:P) :- !,'$show_trie_stats'(P,M).
|
||||
show_trie_stats(P) :- '$current_module'(M), '$show_trie_stats'(P,M).
|
||||
|
||||
'$show_trie_stats'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie_stats).
|
||||
'$show_trie_stats'((P1,P2),M) :- !, '$show_trie_stats'(P1,M), '$show_trie_stats'(P2,M).
|
||||
'$show_trie_stats'(P/N,M) :- atom(P), integer(N), !,
|
||||
functor(T,P,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 0x000040, X =\= 0, !, '$do_show_trie_stats'(T,M)
|
||||
;
|
||||
write(user_error, '[ PERMISSION ERROR- '),
|
||||
write(user_error, M:P/N),
|
||||
write(user_error, ' is not tabled ]'),
|
||||
nl(user_error), fail
|
||||
).
|
||||
'$show_trie_stats'(P,_) :- '$do_error'(type_error(callable,P),show_trie_stats).
|
||||
|
||||
'$resume_trie'(X,_) :- var(X), !,
|
||||
write(user_error, '[ Error: argument to trie/1 should be a predicate ]'),
|
||||
nl(user_error),
|
||||
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)
|
||||
;
|
||||
write(user_error, '[ Error: '),
|
||||
write(user_error, A/N),
|
||||
write(user_error, ' is not declared as table ]'),
|
||||
nl(user_error),
|
||||
fail
|
||||
).
|
||||
'$resume_trie'(X,M) :- write(user_error, '[ Error: '),
|
||||
write(user_error, M:X),
|
||||
write(user_error, ' is an invalid argument to trie/1 ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
|
||||
Reference in New Issue
Block a user