385 lines
12 KiB
C
385 lines
12 KiB
C
/************************************************************************
|
|
** **
|
|
** The YapTab/YapOr/OPTYap systems **
|
|
** **
|
|
** YapTab extends the Yap Prolog engine to support sequential tabling **
|
|
** YapOr extends the Yap Prolog engine to support or-parallelism **
|
|
** OPTYap extends the Yap Prolog engine to support or-parallel tabling **
|
|
** **
|
|
** **
|
|
** Yap Prolog was developed at University of Porto, Portugal **
|
|
** **
|
|
************************************************************************/
|
|
|
|
#ifdef SCCS
|
|
static char SccsId[] = "%W% %G%";
|
|
#endif /* SCCS */
|
|
|
|
#define IsArrayReference(a) ((a)->array_access_func == FunctorArrayAccess)
|
|
|
|
/* dereferencing macros */
|
|
|
|
/************************************************************
|
|
|
|
Dereferencing macros
|
|
|
|
*************************************************************/
|
|
|
|
/* For DEREFD, D has both the input and the exit argument */
|
|
/* A is only used locally */
|
|
|
|
#define deref_head(D,Label) if (IsVarTerm(D)) goto Label
|
|
|
|
#define deref_body(D,A,LabelUnk,LabelNonVar) \
|
|
do { \
|
|
if(!IsVarTerm(D)) goto LabelNonVar; \
|
|
LabelUnk: \
|
|
(A) = (CELL *)(D); \
|
|
(D) = *(CELL *)(D); \
|
|
} while (0 != (D))
|
|
|
|
#define derefa_body(D,A,LabelUnk,LabelNonVar) \
|
|
do { \
|
|
(A) = (CELL *)(D); \
|
|
(D) = *(CELL *)(D); \
|
|
if(!IsVarTerm(D)) goto LabelNonVar; \
|
|
LabelUnk: \
|
|
} while (0 != (D))
|
|
|
|
#if UNIQUE_TAG_FOR_PAIRS
|
|
|
|
/* If you have an unique tag for pairs you can use these macros which will
|
|
speed up detection of dereferenced pairs, but will be slow
|
|
for the other cases.
|
|
|
|
The only instruction where this seems useful is
|
|
switch_list_nl
|
|
*/
|
|
|
|
#define deref_list_head(D,Label) if (!IsPairTerm(D)) goto Label
|
|
|
|
#define deref_list_body(D,A,LabelList,LabelNonVar) \
|
|
do { \
|
|
if (!IsVarTerm(D)) goto LabelNonVar; \
|
|
(A) = (CELL *)(D); \
|
|
(D) = *(A); \
|
|
if (0 == (D)) break; \
|
|
if (IsPairTerm(D)) goto LabelList; \
|
|
} while (TRUE);
|
|
#endif /* UNIQUE_TAG_FOR_PAIRS */
|
|
|
|
EXTERN inline Term Deref(Term a)
|
|
{
|
|
while(IsVarTerm(a)) {
|
|
Term *b = (Term *) a;
|
|
a = *b;
|
|
if(a==0) return (Term)b;
|
|
}
|
|
return(a);
|
|
}
|
|
|
|
EXTERN inline Term Derefa(CELL *b)
|
|
{
|
|
Term a = *b;
|
|
restart:
|
|
if (!IsVarTerm(a)) {
|
|
return(a);
|
|
} else if (a == 0) {
|
|
return((CELL)b);
|
|
} else {
|
|
b = (CELL *)a;
|
|
a = *b;
|
|
goto restart;
|
|
}
|
|
}
|
|
|
|
/************************************************************
|
|
|
|
TRAIL VARIABLE
|
|
|
|
A contains the address of the variable that is to be trailed
|
|
|
|
*************************************************************/
|
|
|
|
|
|
/* #define TRAIL(A) if ((A) < HBREG || (A) > B) TrailTerm(TR++) = Unsigned(A)
|
|
*/
|
|
|
|
#define RESET_VARIABLE(V) (*(CELL *)(V) = 0)
|
|
|
|
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
|
|
inline EXTERN void
|
|
AlignGlobalForDouble(void)
|
|
{
|
|
/* Force Alignment for floats. Note that garbage collector may
|
|
break the alignment; */
|
|
if (!DOUBLE_ALIGNED(H)) {
|
|
RESET_VARIABLE(H);
|
|
H++;
|
|
}
|
|
}
|
|
#endif /* SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT */
|
|
|
|
#ifdef YAPOR
|
|
|
|
#define DO_TRAIL(TERM, VAL) \
|
|
{ \
|
|
register tr_fr_ptr r; \
|
|
r = TR; \
|
|
TR = r + 1; \
|
|
TrailTerm(r) = (CELL) (TERM); \
|
|
TrailVal(r) = (VAL); \
|
|
}
|
|
|
|
#define DO_MATRAIL(TERM, OLDVAL, NEWVAL) \
|
|
{ \
|
|
register tr_fr_ptr r = TR+1; \
|
|
TrailTerm(TR) = (OLDVAL); /* disgusting hack */ \
|
|
TrailTerm(r) = AbsAppl(TERM); \
|
|
TrailVal(r) = (NEWVAL); \
|
|
TR = r+1; \
|
|
}
|
|
|
|
#define TRAIL_REF(REF) TrailTerm(TR++) = AbsPair(((CELL *)(REF)))
|
|
|
|
/* convert to offset */
|
|
#define STACK_TO_SBA(A) (CELL *)(((char *)(A)+sba_offset))
|
|
|
|
#define IN_SBA(A) ((CELL)((char *)(A)-binding_array) < sba_size)
|
|
|
|
#define SBA_TO_STACK(A) (CELL *)(((char *)(A)-sba_offset))
|
|
|
|
/* put the binding in the SBA and force ptr to point there */
|
|
#define BIND_SHARED_VARIABLE(A, D) { \
|
|
CELL *ptr; \
|
|
/*shared_binds++;*/ \
|
|
if (IN_SBA(A)) { \
|
|
ptr = SBA_TO_STACK(A); \
|
|
DO_TRAIL(ptr,D); \
|
|
*(A) = (D); \
|
|
} else { \
|
|
DO_TRAIL((A),D); \
|
|
ptr = STACK_TO_SBA(A); \
|
|
*(A) = (CELL)ptr; \
|
|
*ptr = (D); \
|
|
} \
|
|
}
|
|
|
|
/* put the binding in the SBA and force ptr to point there */
|
|
#define MABIND_SHARED_VARIABLE(A, D) { \
|
|
/*shared_binds++;*/ \
|
|
if (IN_SBA(A)) { \
|
|
CELL *sptr = SBA_TO_STACK(A); \
|
|
DO_MATRAIL(sptr, *(A), D); \
|
|
*(A) = (D); \
|
|
} else { \
|
|
CELL *ptr3; \
|
|
DO_MATRAIL((A), *(A), D); \
|
|
ptr3 = STACK_TO_SBA(A); \
|
|
*(A) = (CELL)ptr3; \
|
|
*ptr3 = (D); \
|
|
} \
|
|
}
|
|
|
|
extern int condit_binds, shared_binds, uncond_binds;
|
|
|
|
/* put the binding in the stacks even though it is conditional */
|
|
#define BIND_CONDITIONALLY(A, D) { \
|
|
DO_TRAIL(A,D); \
|
|
/*condit_binds++; */\
|
|
*(A) = (D); \
|
|
}
|
|
|
|
/* put the binding in the stacks even though it is conditional */
|
|
#define MABIND_CONDITIONALLY(A, D) { \
|
|
DO_MATRAIL(A,*(A),D); \
|
|
/*condit_binds++; */\
|
|
*(A) = (D); \
|
|
}
|
|
|
|
#define DO_CONDITIONAL_BINDING(A,D) { \
|
|
if (Unsigned((Int)(A)-(Int)(H_FZ)) > \
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) \
|
|
{ BIND_SHARED_VARIABLE(A, D); } \
|
|
else { BIND_CONDITIONALLY(A,D); } \
|
|
}
|
|
|
|
#define DO_CONDITIONAL_MABINDING(A,D) { \
|
|
if (Unsigned((Int)(A)-(Int)(H_FZ)) > \
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) \
|
|
{ MABIND_SHARED_VARIABLE(A, D); } \
|
|
else { MABIND_CONDITIONALLY(A,D); } \
|
|
}
|
|
|
|
#define Bind(A,D) { \
|
|
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
|
|
Unsigned(BBREG)-(Int)(HBREG)) \
|
|
{ DO_CONDITIONAL_BINDING(A, D); } \
|
|
else /* uncond_binds++, */ *(A) = (D); \
|
|
}
|
|
|
|
#define BIND(A,D,L) Bind(A,D)
|
|
|
|
#define MaBind(A,D) { \
|
|
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
|
|
Unsigned(BBREG)-(Int)(HBREG)) \
|
|
{ DO_CONDITIONAL_MABINDING(A, D); } \
|
|
else /* uncond_binds++, */ *(A) = (D); \
|
|
}
|
|
|
|
/* I can't gain much here because of the frozen registers */
|
|
#define Bind_Global(A,D) Bind(A,D)
|
|
|
|
#define Bind_Local(A,D) Bind(A,D)
|
|
|
|
#define BIND_GLOBAL(A,D,L) Bind(A,D)
|
|
|
|
#define BIND_GLOBAL2(A,D,L1,L2) Bind(A,D)
|
|
|
|
#define BIND_GLOBALCELL(A,D) Bind(A,D); continue
|
|
|
|
#else /* YAPOR */
|
|
#ifdef TABLING
|
|
#define DO_TRAIL(TERM, VAL) \
|
|
{ \
|
|
register tr_fr_ptr r; \
|
|
r = TR; \
|
|
TR = r + 1; \
|
|
TrailTerm(r) = (CELL) (TERM); \
|
|
TrailVal(r) = (VAL); \
|
|
}
|
|
|
|
#define DO_MATRAIL(TERM, OLDVAL, VAL) \
|
|
{ \
|
|
register tr_fr_ptr r = TR+1; \
|
|
TrailTerm(TR) = (OLDVAL); /* disgusting hack */ \
|
|
TR = r + 1; \
|
|
TrailTerm(r) = AbsAppl((CELL *)(TERM)); \
|
|
TrailVal(r) = (NEWVAL); \
|
|
}
|
|
|
|
#define TRAIL(TERM, VAL) \
|
|
if (Unsigned((Int)(TERM)-(Int)(HBREG)) > \
|
|
Unsigned((Int)(B)-(Int)(HBREG))) \
|
|
DO_TRAIL(TERM, VAL)
|
|
|
|
#define MATRAIL(TERM, OVAL, VAL) \
|
|
if (Unsigned((Int)(TERM)-(Int)(HBREG)) > \
|
|
Unsigned((Int)(B)-(Int)(HBREG))) \
|
|
DO_MATRAIL(TERM, OVAL, VAL)
|
|
|
|
#define TRAIL_GLOBAL(TERM, VAL) \
|
|
if ((TERM) < HBREG) DO_TRAIL(TERM, VAL)
|
|
|
|
#define TRAIL_LOCAL(TERM, VAL) \
|
|
if ((TERM) > (CELL *)B) DO_TRAIL(TERM, VAL)
|
|
|
|
#define TRAIL_REF(REF) TrailTerm(TR++) = AbsPair(((CELL *)(REF)))
|
|
|
|
#define Bind(A,D) { TRAIL(A,D); *(A) = (D); }
|
|
|
|
#define MaBind(A,D) { MATRAIL(A,*(A),D); *(A) = (D); }
|
|
|
|
#define Bind_Global(A,D) { TRAIL_GLOBAL(A,D); *(A) = (D); }
|
|
|
|
#define Bind_Local(A,D) { TRAIL_LOCAL(A,D); *(A) = (D); }
|
|
|
|
#else /* TABLING */
|
|
|
|
#ifdef i386
|
|
|
|
#define DO_TRAIL(A) \
|
|
{ \
|
|
register tr_fr_ptr r; \
|
|
r = TR; \
|
|
TR = r+1; \
|
|
TrailTerm(r) = (CELL)(A); \
|
|
}
|
|
|
|
|
|
#define TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
|
|
Unsigned((Int)(B)-(Int)(HBREG))) \
|
|
DO_TRAIL(A);
|
|
|
|
#define TRAIL_GLOBAL(A) if ((A) < HBREG) DO_TRAIL(A);
|
|
|
|
#define TRAIL_LOCAL(A) if ((A) > (CELL *)B) DO_TRAIL(A);
|
|
|
|
|
|
#elif __alpha
|
|
|
|
/* alpha machines have a move conditional instruction, which avoids a
|
|
branch when jumping */
|
|
#define TRAIL(A) TrailTerm(TR) = (CELL)(A); \
|
|
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
|
|
Unsigned((Int)(B)-(Int)(HBREG))) \
|
|
TR++
|
|
|
|
#define TRAIL_GLOBAL(A) TR[0] = (CELL)(A); if ((A) < HBREG) TR++
|
|
|
|
#define TRAIL_LOCAL(A) TR[0] = (CELL)(A); if ((A) > ((CELL *)(B))) TR++
|
|
|
|
#else
|
|
|
|
#define DO_TRAIL(A) TrailTerm(TR++) = (CELL)(A)
|
|
|
|
#define TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
|
|
Unsigned((Int)(B)-(Int)(HBREG))) \
|
|
DO_TRAIL(A)
|
|
|
|
#define TRAIL_GLOBAL(A) if ((A) < HBREG) DO_TRAIL(A)
|
|
|
|
#define TRAIL_LOCAL(A) if ((A) > ((CELL *)B)) DO_TRAIL(A)
|
|
|
|
#endif /* i386, _alpha */
|
|
|
|
#define TRAIL_REF(Ref) (TrailTerm(TR++) = AbsPair(((CELL *)(Ref))))
|
|
|
|
/************************************************************
|
|
|
|
BINDING MACROS
|
|
|
|
A contains the address of the variable that is to be bound
|
|
D contains the value it will be bound to
|
|
|
|
*************************************************************/
|
|
|
|
#define Bind(A,D) { TRAIL(A); *(A) = (D); }
|
|
|
|
#define Bind_Global(A,D) { TRAIL_GLOBAL(A); *(A) = (D); }
|
|
|
|
#define Bind_Local(A,D) { TRAIL_LOCAL(A); *(A) = (D); }
|
|
|
|
/************************************************************
|
|
|
|
Binding Macros for Multiple Assignment Variables.
|
|
|
|
************************************************************/
|
|
|
|
#define MA_TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
|
|
Unsigned((Int)(B)-(Int)(HBREG))) \
|
|
{ TrailTerm(TR++) = *(A); \
|
|
TrailTerm(TR++) = AbsAppl(A); \
|
|
}
|
|
|
|
#define MaBind(A,D) { MA_TRAIL(A); *(A) = (D); }
|
|
|
|
#endif /* TABLING */
|
|
#endif /* YAPOR */
|
|
|
|
#ifdef YAPOR
|
|
|
|
/* these two fields are used for memory management with the
|
|
clean_up_node instruction in the YAPOR/SBA implementation */
|
|
#define CP_FREE(B) ((int)((B)->cp_env))
|
|
#define CP_NEXT(B) ((choiceptr)((B)->cp_cp))
|
|
|
|
#endif /* YAPOR */
|
|
|
|
#define DBIND(A,D,L) BIND(A,D,L)
|
|
|
|
#define EQ_OK_IN_CMP 1
|
|
#define LT_OK_IN_CMP 2
|
|
#define GT_OK_IN_CMP 4
|
|
|