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

Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

Browse Source
This commit is contained in:
Vítor Santos Costa II 2010-04-19 15:58:41 +01:00
commit 9f7df27e3a
52 changed files with 1062 additions and 1463 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
C/grow.c
View File

@ -268,14 +268,9 @@ RestoreTrail(int worker_p)
while (TR != aux_tr) {
CELL aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) {
if (aux_cell < LOCAL_start_global_copy ||
EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) {
#ifdef YAPOR_ERRORS
if ((CELL *)aux_cell < H0)
YAPOR_ERROR_MESSAGE("aux_cell < H0 (q_share_work)");
if ((ADDR)aux_cell > Yap_LocalBase)
YAPOR_ERROR_MESSAGE("aux_cell > LocalBase (q_share_work)");
#endif /* YAPOR_ERRORS */
if (aux_cell < LOCAL_start_global_copy || EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) {
YAPOR_ERROR_CHECKING((CELL *)aux_cell < H0, "RestoreTrail: aux_cell < H0");
YAPOR_ERROR_CHECKING((ADDR)aux_cell > Yap_LocalBase, "RestoreTrail: aux_cell > LocalBase");
#ifdef TABLING
*((CELL *) aux_cell) = TrailVal(aux_tr);
#else

36
C/save.c
View File

@ -497,25 +497,10 @@ save_heap(void)
int j;
/* Then save the whole heap */
Yap_ResetConsultStack();
#if defined(YAPOR) || (defined(TABLING) && !defined(YAP_MEMORY_ALLOC_SCHEME))
Yap_ResetConsultStack();
Yap_CloseScratchPad();
/* skip the local and global data structures */
j = Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase);
if (putout(j) < 0)
return -1;
mywrite(splfild, (char *) Yap_HeapBase, j);
j = Unsigned(HeapTop) - Unsigned(REMOTE+MAX_WORKERS);
if (putout(j) < 0)
return -1;
if (mywrite(splfild, (char *) &(REMOTE[MAX_WORKERS]), j) < 0)
return -1;
#else
j = Unsigned(HeapTop) - Unsigned(Yap_HeapBase);
/* store 10 more cells because of the memory manager */
if (mywrite(splfild, (char *) Yap_HeapBase, j) < 0)
return -1;
#endif /* YAPOR || (TABLING && !YAP_MEMORY_ALLOC_SCHEME) */
return 0;
}
@ -934,27 +919,8 @@ get_hash(void)
static int
CopyCode(void)
{
#if defined(YAPOR) || (defined(TABLING) && !defined(YAP_MEMORY_ALLOC_SCHEME))
/* skip the local and global data structures */
CELL j = get_cell();
if (Yap_ErrorMessage)
if (myread(splfild, (char *) Yap_HeapBase, (Unsigned(OldHeapTop) - Unsigned(OldHeapBase))) < 0)
return -1;
if (j != Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase)) {
Yap_ErrorMessage = "code space size does not match saved state";
return -1;
}
if (myread(splfild, (char *) Yap_HeapBase, j) < 0)
return -1;
j = get_cell();
if (Yap_ErrorMessage)
return -1;
if (myread(splfild, (char *) &(REMOTE[MAX_WORKERS]), j) < 0)
return -1;
#else
if (myread(splfild, (char *) Yap_HeapBase,
(Unsigned(OldHeapTop) - Unsigned(OldHeapBase))) < 0)
return -1;
#endif /* YAPOR || (TABLING && !YAP_MEMORY_ALLOC_SCHEME) */
return 1;
}

20
C/scanner.c
View File

@ -548,17 +548,15 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
}
*chp = ch;
}
else if ((ch == 'o') && base == 0) {
else if ((ch == 'o' || ch == 'O') && base == 0) {
might_be_float = FALSE;
base = 8;
if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long";
return (TermNil);
}
*sp++ = ch;
*chp = Nxtch(inp_stream);
}
else {
ch = Nxtch(inp_stream);
} else if ((ch == 'b' || ch == 'B') && base == 0) {
might_be_float = FALSE;
base = 2;
ch = Nxtch(inp_stream);
} else {
val = base;
base = 10;
}
@ -666,6 +664,10 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
*chp = ch;
if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X'))
return read_int_overflow(s+2,16,val,sign);
else if (s[0] == '0' && (s[1] == 'o' || s[1] == 'O'))
return read_int_overflow(s+2,8,val,sign);
else if (s[0] == '0' && (s[1] == 'b' || s[1] == 'B'))
return read_int_overflow(s+2,2,val,sign);
if (s[1] == '\'')
return read_int_overflow(s+2,base,val,sign);
if (s[2] == '\'')

20
H/Yap.h
View File

@ -336,22 +336,22 @@ typedef CELL Term;
#define _XOPEN_SOURCE 600
#endif
#include <pthread_locks.h>
#include <locks_pthread.h>
typedef pthread_mutex_t lockvar;
typedef pthread_rwlock_t rwlock_t;
#elif defined(i386) || defined(__x86_64__)
typedef volatile int lockvar;
#include <x86_locks.h>
#include <locks_x86.h>
#elif defined(sparc) || defined(__sparc)
typedef volatile int lockvar;
#include <sparc_locks.h>
#include <locks_sparc.h>
#elif defined(mips)
typedef volatile int lockvar;
#include <mips_locks.h>
#include <locks_mips.h>
#elif defined(__alpha)
typedef volatile int lockvar;
#include <alpha_locks.h>
#include <locks_alpha.h>
#else
#ifndef _XOPEN_SOURCE
@ -360,7 +360,7 @@ typedef volatile int lockvar;
typedef pthread_mutex_t lockvar;
typedef pthread_rwlock_t rwlock_t;
#include <pthread_locks.h>
#include <locks_pthread.h>
#endif
/********************** use an auxiliary function for ranges ************/
@ -397,10 +397,10 @@ typedef pthread_rwlock_t rwlock_t;
#if defined(YAPOR) ||defined(THREADS)
#ifdef mips
#include <mips_locks_funcs.h>
#include <locks_mips_funcs.h>
#endif
#ifdef __alpha
#include <alpha_locks_funcs.h>
#include <locks_alpha_funcs.h>
#endif
#ifdef YAPOR
#define MAX_AGENTS MAX_WORKERS
@ -1033,7 +1033,7 @@ IntegerOfTerm (Term t)
/*************** unification routines ***********************************/
#ifdef SBA
#include "sbaamiops.h"
#include "or.sbaamiops.h"
#else
#include "amiops.h"
#endif
@ -1270,7 +1270,7 @@ extern char emacs_tmp[], emacs_tmp2[];
#endif /* YAPOR || TABLING */
#ifdef SBA
#include "sbaunify.h"
#include "or.sbaunify.h"
#endif
/********* execution mode ***********************/

4
H/dglobals.h
View File

@ -1,4 +1,8 @@
/* This file, dglobals.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/GLOBALS instead */

4
H/dhstruct.h
View File

@ -1,4 +1,8 @@
/* This file, dhstruct.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/HEAPFIELDS instead */

4
H/hglobals.h
View File

@ -1,4 +1,8 @@
/* This file, hglobals.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/GLOBALS instead */

4
H/hstruct.h
View File

@ -1,4 +1,8 @@
/* This file, hstruct.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/HEAPFIELDS instead */

4
H/iatoms.h
View File

@ -1,3 +1,7 @@
/* This file, iatoms.h, was generated automatically by "yap -L misc/buildatoms"
please do not update, update misc/ATOMS instead */
Atom3Dots = Yap_LookupAtom("...");
AtomAbol = Yap_FullLookupAtom("$abol");
AtomAccess = Yap_LookupAtom("access");

4
H/iglobals.h
View File

@ -1,4 +1,8 @@
/* This file, iglobals.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/GLOBALS instead */

4
H/ihstruct.h
View File

@ -1,4 +1,8 @@
/* This file, ihstruct.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/HEAPFIELDS instead */

4
H/ratoms.h
View File

@ -1,3 +1,7 @@
/* This file, ratoms.h, was generated automatically by "yap -L misc/buildatoms"
please do not update, update misc/ATOMS instead */
Atom3Dots = AtomAdjust(Atom3Dots);
AtomAbol = AtomAdjust(AtomAbol);
AtomAccess = AtomAdjust(AtomAccess);

4
H/rglobals.h
View File

@ -1,4 +1,8 @@
/* This file, rglobals.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/GLOBALS instead */

4
H/rhstruct.h
View File

@ -1,4 +1,8 @@
/* This file, rhstruct.h, was generated automatically by "yap -L misc/buildheap"
please do not update, update misc/HEAPFIELDS instead */

4
H/tatoms.h
View File

@ -1,3 +1,7 @@
/* This file, tatoms.h, was generated automatically by "yap -L misc/buildatoms"
please do not update, update misc/ATOMS instead */
Atom Atom3Dots_;
#define Atom3Dots Yap_heap_regs->Atom3Dots_
Atom AtomAbol_;

28
Makefile.in
View File

@ -146,12 +146,12 @@ HEADERS = \
$(srcdir)/OPTYap/opt.config.h \
$(srcdir)/OPTYap/opt.proto.h $(srcdir)/OPTYap/opt.structs.h \
$(srcdir)/OPTYap/opt.macros.h $(srcdir)/OPTYap/or.macros.h \
$(srcdir)/OPTYap/sbaamiops.h $(srcdir)/OPTYap/sbaunify.h \
$(srcdir)/OPTYap/tab.structs.h $(srcdir)/OPTYap/x86_locks.h \
$(srcdir)/OPTYap/sparc_locks.h $(srcdir)/OPTYap/mips_locks.h \
$(srcdir)/OPTYap/mips_locks_funcs.h $(srcdir)/OPTYap/alpha_locks.h \
$(srcdir)/OPTYap/alpha_locks_funcs.h \
$(srcdir)/OPTYap/pthread_locks.h \
$(srcdir)/OPTYap/or.sbaamiops.h $(srcdir)/OPTYap/or.sbaunify.h \
$(srcdir)/OPTYap/tab.structs.h $(srcdir)/OPTYap/locks_x86.h \
$(srcdir)/OPTYap/locks_sparc.h $(srcdir)/OPTYap/locks_mips.h \
$(srcdir)/OPTYap/locks_mips_funcs.h $(srcdir)/OPTYap/locks_alpha.h \
$(srcdir)/OPTYap/locks_alpha_funcs.h \
$(srcdir)/OPTYap/locks_pthread.h \
$(srcdir)/H/cut_c.h \
$(srcdir)/H/iatoms.h $(srcdir)/H/ratoms.h $(srcdir)/H/tatoms.h \
$(srcdir)/MYDDAS/myddas.h $(srcdir)/MYDDAS/myddas_structs.h \
@ -197,13 +197,12 @@ C_SOURCES= \
$(srcdir)/BEAM/eam_am.c $(srcdir)/BEAM/eam_showcode.c \
$(srcdir)/BEAM/eamindex.c $(srcdir)/BEAM/eamamasm.c \
$(srcdir)/BEAM/eam_gc.c $(srcdir)/BEAM/eam_split.c \
$(srcdir)/OPTYap/opt.memory.c $(srcdir)/OPTYap/opt.misc.c \
$(srcdir)/OPTYap/opt.init.c \
$(srcdir)/OPTYap/opt.memory.c $(srcdir)/OPTYap/opt.init.c \
$(srcdir)/OPTYap/opt.preds.c $(srcdir)/OPTYap/or.engine.c \
$(srcdir)/OPTYap/or.cowengine.c $(srcdir)/OPTYap/or.sbaengine.c \
$(srcdir)/OPTYap/or.threadengine.c \
$(srcdir)/OPTYap/or.scheduler.c $(srcdir)/OPTYap/or.cut.c \
$(srcdir)/OPTYap/tab.tries.c $(srcdir)/OPTYap/tab.suspend.c \
$(srcdir)/OPTYap/tab.tries.c $(srcdir)/OPTYap/tab.completion.c \
$(srcdir)/library/mpi/mpi.c $(srcdir)/library/mpi/mpe.c \
$(srcdir)/library/lammpi/yap_mpi.c $(srcdir)/library/lammpi/hash.c $(srcdir)/library/lammpi/prologterms2c.c \
$(srcdir)/C/cut_c.c \
@ -280,10 +279,10 @@ C_INTERFACE_OBJECTS = \
c_interface.o clause_list.o
OR_OBJECTS = \
opt.memory.o opt.misc.o opt.init.o opt.preds.o \
opt.memory.o opt.init.o opt.preds.o \
or.engine.o or.cowengine.o or.sbaengine.o or.threadengine.o \
or.scheduler.o or.cut.o \
tab.tries.o tab.suspend.o
tab.tries.o tab.completion.o
BEAM_OBJECTS = \
eamamasm.o eam_showcode.o eamindex.o eam_am.o
@ -391,9 +390,6 @@ myddas_statistics.o: $(srcdir)/MYDDAS/myddas_statistics.c config.h
opt.memory.o: $(srcdir)/OPTYap/opt.memory.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/OPTYap/opt.memory.c -o $@
opt.misc.o: $(srcdir)/OPTYap/opt.misc.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/OPTYap/opt.misc.c -o $@
opt.init.o: $(srcdir)/OPTYap/opt.init.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/OPTYap/opt.init.c -o $@
@ -421,8 +417,8 @@ or.scheduler.o: $(srcdir)/OPTYap/or.scheduler.c config.h
tab.tries.o: $(srcdir)/OPTYap/tab.tries.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/OPTYap/tab.tries.c -o $@
tab.suspend.o: $(srcdir)/OPTYap/tab.suspend.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/OPTYap/tab.suspend.c -o $@
tab.completion.o: $(srcdir)/OPTYap/tab.completion.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/OPTYap/tab.completion.c -o $@
eam_showcode.o: $(srcdir)/BEAM/eam_showcode.c config.h
$(CC) -c $(CFLAGS) $(srcdir)/BEAM/eam_showcode.c -o $@

0
OPTYap/alpha_locks.h → OPTYap/locks_alpha.h
View File

0
OPTYap/alpha_locks_funcs.h → OPTYap/locks_alpha_funcs.h
View File

0
OPTYap/mips_locks.h → OPTYap/locks_mips.h
View File

0
OPTYap/mips_locks_funcs.h → OPTYap/locks_mips_funcs.h
View File

0
OPTYap/pthread_locks.h → OPTYap/locks_pthread.h
View File

0
OPTYap/sparc_locks.h → OPTYap/locks_sparc.h
View File

0
OPTYap/x86_locks.h → OPTYap/locks_x86.h
View File

14
OPTYap/opt.config.h
View File

@ -75,7 +75,7 @@
/*************************************************
** enable error checking ? (optional) **
*************************************************/
/* #define TABLING_ERRORS 1 */
/* #define DEBUG_TABLING 1 */
@ -99,7 +99,7 @@
/*************************************************
** enable error checking ? (optional) **
*************************************************/
/* #define YAPOR_ERRORS 1 */
/* #define DEBUG_YAPOR 1 */
@ -225,7 +225,7 @@
#endif /* !TABLING || !YAPOR */
#ifndef YAPOR
#undef YAPOR_ERRORS
#undef DEBUG_YAPOR
#endif /* !YAPOR */
#ifndef TABLING
@ -238,13 +238,13 @@
#undef DETERMINISTIC_TABLING
#undef LIMIT_TABLING
#undef INCOMPLETE_TABLING
#undef TABLING_ERRORS
#undef DEBUG_TABLING
#endif /* !TABLING */
#ifndef SHM_MEMORY_ALLOC_SCHEME
#undef LIMIT_TABLING
#endif /* !SHM_MEMORY_ALLOC_SCHEME */
#if defined(YAPOR_ERRORS) && defined(TABLING_ERRORS)
#define OPTYAP_ERRORS
#endif /* YAPOR_ERRORS && TABLING_ERRORS */
#if defined(DEBUG_YAPOR) && defined(DEBUG_TABLING)
#define DEBUG_OPTYAP
#endif /* DEBUG_YAPOR && DEBUG_TABLING */

30
OPTYap/opt.init.c
View File

@ -44,6 +44,17 @@ ma_h_inner_struct *Yap_ma_h_top;
/************************************************
** Global variables are defined here **
************************************************/
#if defined(YAPOR) && ! defined(THREADS)
struct worker WORKER;
#endif /* YAPOR && ! THREADS */
/*********************
** Macros **
*********************/
@ -139,9 +150,6 @@ void Yap_init_global(int max_table_size, int n_workers, int sch_loop, int delay_
GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS;
INIT_LOCK(GLOBAL_LOCKS_heap_access);
INIT_LOCK(GLOBAL_LOCKS_alloc_block);
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
INIT_LOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
if (number_workers == 1)
PARALLEL_EXECUTION_MODE = FALSE;
else
@ -282,4 +290,20 @@ void init_workers(void) {
}
}
#endif /* YAPOR */
void itos(int i, char *s) {
int n,r,j;
n = 10;
while (n <= i) n *= 10;
j = 0;
while (n > 1) {
n = n / 10;
r = i / n;
i = i - r * n;
s[j++] = r + '0';
}
s[j] = 0;
return;
}
#endif /* YAPOR || TABLING */

196
OPTYap/opt.macros.h
View File

@ -11,9 +11,11 @@
** **
************************************************************************/
/********************************
** Memory management **
********************************/
/************************************************************************
** Memory management **
************************************************************************/
extern int Yap_page_size;
#ifdef SHM_MEMORY_ALLOC_SCHEME
#include <sys/shm.h>
@ -22,8 +24,6 @@
/* #define SHMMAX 0x800000 - 8 Mbytes: shmget limit for Solaris (?) */
#endif /* SHM_MEMORY_ALLOC_SCHEME */
extern int Yap_page_size;
#if SIZEOF_INT_P == 4
#define ALIGN 3
#define ALIGNMASK 0xfffffffc
@ -43,48 +43,58 @@ extern int Yap_page_size;
#define UPDATE_STATS(STAT, VALUE) STAT += VALUE
#ifdef MALLOC_MEMORY_ALLOC_SCHEME /********************************************************************/
#ifdef MALLOC_MEMORY_ALLOC_SCHEME
/********************************************************************************************************
** MALLOC_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
if ((STR = (STR_TYPE *) malloc(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "ALLOC_BLOCK: malloc error")
#define FREE_BLOCK(STR) \
free(STR)
#else
/********************************************************************************************************
** ! MALLOC_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
{ char *block_ptr; \
if ((block_ptr = Yap_AllocCodeSpace(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'y'; \
else if ((block_ptr = (char *) malloc(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'm'; \
else \
Yap_Error(FATAL_ERROR, TermNil, "ALLOC_BLOCK: malloc error"); \
block_ptr += sizeof(CELL); \
STR = (STR_TYPE *) block_ptr; \
}
#define FREE_BLOCK(STR) \
{ char *block_ptr = (char *)(STR) - sizeof(CELL); \
if (block_ptr[0] == 'y') \
Yap_FreeCodeSpace(block_ptr); \
else \
free(block_ptr); \
}
#endif /************************************************************************************************/
#if defined(MALLOC_MEMORY_ALLOC_SCHEME) || defined(YAP_MEMORY_ALLOC_SCHEME)
/********************************************************************************************************
** MALLOC_MEMORY_ALLOC_SCHEME || YAP_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
if ((STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_STRUCT)")
ALLOC_BLOCK(STR, sizeof(STR_TYPE), STR_TYPE)
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE)
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
free(STR)
#elif YAP_MEMORY_ALLOC_SCHEME /************************************************************************/
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ char *ptr = Yap_AllocCodeSpace(sizeof(STR_TYPE) + sizeof(CELL)); \
if (ptr) { \
*ptr = 'y'; \
ptr += sizeof(CELL); \
STR = (STR_TYPE *)ptr; \
} else { \
ptr = (char *)malloc(sizeof(STR_TYPE) + sizeof(CELL)); \
if (ptr) { \
*ptr = 'm'; \
ptr += sizeof(CELL); \
STR = (STR_TYPE *)ptr; \
} else { \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_STRUCT)"); \
STR = NULL; \
} \
} \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
}
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE)
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ char *ptr = (char *)(STR) - sizeof(CELL); \
if (ptr[0] == 'y') { \
Yap_FreeCodeSpace(ptr); \
} else \
free(ptr); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
}
#elif SHM_MEMORY_ALLOC_SCHEME /************************************************************************/
FREE_BLOCK(STR)
#elif SHM_MEMORY_ALLOC_SCHEME
#ifdef LIMIT_TABLING
/********************************************************************************************************
** SHM_MEMORY_ALLOC_SCHEME && LIMIT_TABLING **
********************************************************************************************************/
#define INIT_PAGE(PG_HD, STR_PAGES, STR_TYPE) \
{ int i; \
STR_TYPE *aux_str; \
@ -220,6 +230,9 @@ extern int Yap_page_size;
} \
LOCAL_next_free_ans_node = STRUCT_NEXT(STR)
#else
/********************************************************************************************************
** SHM_MEMORY_ALLOC_SCHEME && !LIMIT_TABLING **
********************************************************************************************************/
#define ALLOC_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
@ -313,7 +326,9 @@ extern int Yap_page_size;
} \
LOCAL_next_free_ans_node = STRUCT_NEXT(STR)
#endif /* LIMIT_TABLING */
/********************************************************************************************************
** SHM_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define FREE_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), -1); \
@ -350,26 +365,12 @@ extern int Yap_page_size;
}
#endif /************************************************************************************************/
#ifdef YAPOR
#define ALLOC_BLOCK(BLOCK, SIZE) \
if ((BLOCK = (void *) Yap_AllocCodeSpace(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "Yap_AllocCodeSpace error (ALLOC_BLOCK)")
#define FREE_BLOCK(BLOCK) \
Yap_FreeCodeSpace((char *) (BLOCK))
#else /* TABLING */
#define ALLOC_BLOCK(BLOCK, SIZE) \
if ((BLOCK = malloc(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_BLOCK)")
#define FREE_BLOCK(BLOCK) \
free(BLOCK)
#endif /* YAPOR - TABLING */
#define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **ptr; \
ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \
BUCKET_PTR = (void *) ptr; \
{ int i; void **bucket_ptr; \
ALLOC_BLOCK(bucket_ptr, NUM_BUCKETS * sizeof(void *), void *); \
BUCKET_PTR = (void *) bucket_ptr; \
for (i = NUM_BUCKETS; i != 0; i--) \
*ptr++ = NULL; \
*bucket_ptr++ = NULL; \
}
#define FREE_HASH_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR)
@ -391,22 +392,9 @@ extern int Yap_page_size;
#define ALLOC_TABLE_ENTRY(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_tab_ent, struct table_entry)
#define FREE_TABLE_ENTRY(STR) FREE_STRUCT(STR, GLOBAL_PAGES_tab_ent, struct table_entry)
#define ALLOC_GLOBAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define FREE_GLOBAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define ALLOC_SUBGOAL_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_fr, struct subgoal_frame)
#define FREE_SUBGOAL_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_fr, struct subgoal_frame)
#ifdef YAPOR
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_NEXT_FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#else /* TABLING */
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#endif /* YAPOR - TABLING */
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#define ALLOC_DEPENDENCY_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_dep_fr, struct dependency_frame)
#define FREE_DEPENDENCY_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_dep_fr, struct dependency_frame)
@ -414,6 +402,19 @@ extern int Yap_page_size;
#define FREE_SUSPENSION_FRAME(STR) FREE_BLOCK(SuspFr_global_start(STR)); \
FREE_STRUCT(STR, GLOBAL_PAGES_susp_fr, struct suspension_frame)
#define ALLOC_GLOBAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define FREE_GLOBAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#ifdef YAPOR
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_NEXT_FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#else /* TABLING */
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#endif /* YAPOR - TABLING */
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#define ALLOC_GLOBAL_TRIE_HASH(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_gt_hash, struct global_trie_hash)
#define FREE_GLOBAL_TRIE_HASH(STR) FREE_STRUCT(STR, GLOBAL_PAGES_gt_hash, struct global_trie_hash)
@ -425,16 +426,15 @@ extern int Yap_page_size;
/******************************************
** Bitmap tests and operations **
******************************************/
/************************************************************************
** Bitmap manipulation **
************************************************************************/
#define BITMAP_empty(b) ((b) == 0)
#define BITMAP_member(b,n) (((b) & (1<<(n))) != 0)
#define BITMAP_alone(b,n) ((b) == (1<<(n)))
#define BITMAP_subset(b1,b2) (((b1) & (b2)) == b2)
#define BITMAP_same(b1,b2) ((b1) == (b2))
#define BITMAP_clear(b) ((b) = 0)
#define BITMAP_and(b1,b2) ((b1) &= (b2))
#define BITMAP_minus(b1,b2) ((b1) &= ~(b2))
@ -446,26 +446,38 @@ extern int Yap_page_size;
/***************************************
** Message and debug macros **
***************************************/
/************************************************************************
** Debug macros **
************************************************************************/
#define INFORMATION_MESSAGE(MESG, ARGS...) information_message(MESG, ##ARGS)
#define INFORMATION_MESSAGE(MESSAGE,ARGS...) \
fprintf(stderr, "[ " MESSAGE " ]\n", ##ARGS)
#ifdef YAPOR_ERRORS
#define YAPOR_ERROR_MESSAGE(MESG, ARGS...) error_message(MESG, ##ARGS)
#ifdef YAPOR
#define ERROR_MESSAGE(MESSAGE) \
Yap_Error(INTERNAL_ERROR, TermNil, "W%d - " MESSAGE, worker_id)
#else
#define YAPOR_ERROR_MESSAGE(MESG, ARGS...)
#endif /* YAPOR_ERRORS */
#define ERROR_MESSAGE(MESSAGE) \
Yap_Error(INTERNAL_ERROR, TermNil, MESSAGE)
#endif /* YAPOR */
#ifdef TABLING_ERRORS
#define TABLING_ERROR_MESSAGE(MESG, ARGS...) error_message(MESG, ##ARGS)
#ifdef DEBUG_TABLING
#define TABLING_ERROR_CHECKING(PROCEDURE,TEST) \
if (TEST) ERROR_MESSAGE(#PROCEDURE ": " #TEST)
#else
#define TABLING_ERROR_MESSAGE(MESG, ARGS...)
#endif /* TABLING_ERRORS */
#define TABLING_ERROR_CHECKING(PROCEDURE,TEST)
#endif /* DEBUG_TABLING */
#ifdef OPTYAP_ERRORS
#define OPTYAP_ERROR_MESSAGE(MESG, ARGS...) error_message(MESG, ##ARGS)
#ifdef DEBUG_YAPOR
#define YAPOR_ERROR_CHECKING(PROCEDURE,TEST) \
if (TEST) ERROR_MESSAGE(#PROCEDURE ": " #TEST)
#else
#define OPTYAP_ERROR_MESSAGE(MESG, ARGS...)
#endif /* OPTYAP_ERRORS */
#define YAPOR_ERROR_CHECKING(PROCEDURE,TEST)
#endif /* DEBUG_YAPOR */
#ifdef DEBUG_OPTYAP
#define OPTYAP_ERROR_CHECKING(PROCEDURE,TEST) \
if (TEST) ERROR_MESSAGE(#PROCEDURE ": " #TEST)
#else
#define OPTYAP_ERROR_CHECKING(PROCEDURE,TEST)
#endif /* DEBUG_OPTYAP */

95
OPTYap/opt.misc.c
View File

@ -1,95 +0,0 @@
/************************************************************************
** **
** 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 **
** **
************************************************************************/
/***********************
** Includes **
***********************/
#include "Yap.h"
#if defined(YAPOR) || defined(TABLING)
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif /* HAVE_UNISTD_H */
#if HAVE_STDARG_H
#include <stdarg.h>
#endif /* HAVE_STDARG_H */
#include "Yatom.h"
#include "yapio.h"
/************************************************
** Global variables are defined here **
************************************************/
#ifndef THREADS
#ifdef YAPOR
struct worker WORKER;
#endif /* YAPOR */
#endif /* ! THREADS */
/*******************************
** Global functions **
*******************************/
void itos(int i, char *s) {
int n,r,j;
n = 10;
while (n <= i) n *= 10;
j = 0;
while (n > 1) {
n = n / 10;
r = i / n;
i = i - r * n;
s[j++] = r + '0';
}
s[j] = 0;
return;
}
void information_message(const char *mesg,...) {
va_list args;
va_start(args, mesg);
fprintf(stderr, "[ ");
vfprintf(stderr, mesg, args);
fprintf(stderr, " ]\n");
return;
}
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
void error_message(const char *mesg, ...) {
va_list args;
va_start(args, mesg);
#ifdef YAPOR
LOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR */
fprintf(stderr, "% POTENCIAL ERROR- ");
#ifdef YAPOR
fprintf(stderr, "W%d: ", worker_id);
#endif /* YAPOR */
vfprintf(stderr, mesg, args);
fprintf(stderr, "\n");
#ifdef YAPOR
UNLOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR */
return;
}
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
#endif /* YAPOR || TABLING */

18
OPTYap/opt.preds.c
View File

@ -75,9 +75,9 @@ static Int p_tabling_statistics(void);
static Int p_opt_statistics(void);
#endif /* YAPOR && TABLING */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
#if defined(DEBUG_YAPOR) || defined(DEBUG_TABLING)
static int p_debug_prolog(void);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
#endif /* DEBUG_YAPOR || DEBUG_TABLING */
#ifdef SHM_MEMORY_ALLOC_SCHEME
static void shm_pages(long pages_in_use, long bytes_in_use);
@ -163,9 +163,9 @@ void Yap_init_optyap_preds(void) {
#if defined(YAPOR) && defined(TABLING)
Yap_InitCPred("opt_statistics", 0, p_opt_statistics, SafePredFlag|SyncPredFlag);
#endif /* YAPOR && TABLING */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
#if defined(DEBUG_YAPOR) || defined(DEBUG_TABLING)
Yap_InitCPred("debug_prolog", 1, p_debug_prolog, SafePredFlag|SyncPredFlag);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
#endif /* DEBUG_YAPOR || DEBUG_TABLING */
}
@ -976,7 +976,7 @@ Int p_opt_statistics(void) {
#endif /* YAPOR && TABLING */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
#if defined(DEBUG_YAPOR) || defined(DEBUG_TABLING)
static
int p_debug_prolog(void) {
Term t;
@ -984,17 +984,17 @@ int p_debug_prolog(void) {
if (IsAtomTerm(t)) {
char *s;
s = RepAtom(AtomOfTerm(t))->StrOfAE;
#ifdef YAPOR_ERRORS
#ifdef DEBUG_YAPOR
fprintf(Yap_stderr, "W%d: %s\n", worker_id, s);
#else /* TABLING_ERRORS */
#else /* DEBUG_TABLING */
fprintf(Yap_stderr, "%s\n", s);
#endif /* YAPOR_ERRORS */
#endif
return(TRUE);
} else {
return (FALSE);
}
}
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
#endif /* DEBUG_YAPOR || DEBUG_TABLING */

35
OPTYap/opt.proto.h
View File

@ -29,18 +29,6 @@ void remap_memory(void);
/*************************
** opt.misc.c **
*************************/
void itos(int, char *);
void information_message(const char *,...);
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
void error_message(const char *, ...);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
/*************************
** opt.init.c **
*************************/
@ -51,6 +39,7 @@ void make_root_frames(void);
#ifdef YAPOR
void init_workers(void);
#endif /* YAPOR */
void itos(int, char *);
@ -72,33 +61,39 @@ void finish_yapor(void);
sg_fr_ptr subgoal_search(yamop *, CELL **);
ans_node_ptr answer_search(sg_fr_ptr, CELL *);
void load_answer(ans_node_ptr, CELL *);
#ifdef GLOBAL_TRIE
CELL *exec_substitution(gt_node_ptr, CELL *);
#endif /* GLOBAL_TRIE */
void update_answer_trie(sg_fr_ptr);
#ifndef GLOBAL_TRIE
void free_subgoal_trie_branch(sg_node_ptr, int, int, int);
#else /* GLOBAL_TRIE */
CELL *exec_substitution(gt_node_ptr, CELL *);
void free_subgoal_trie_branch(sg_node_ptr, int, int);
#endif /* GLOBAL_TRIE */
void free_answer_trie_branch(ans_node_ptr, int);
void update_answer_trie(sg_fr_ptr);
void free_subgoal_trie_hash_chain(sg_hash_ptr);
void free_answer_trie_hash_chain(ans_hash_ptr);
void show_table(tab_ent_ptr, int);
#ifdef GLOBAL_TRIE
void show_global_trie(int);
#endif /* GLOBAL_TRIE */
void private_completion(sg_fr_ptr);
#endif /* TABLING */
/****************************
** tab.suspend.c **
****************************/
/*******************************
** tab.completion.c **
*******************************/
#if defined(TABLING) && defined(YAPOR)
#ifdef TABLING
void private_completion(sg_fr_ptr);
#ifdef YAPOR
void public_completion(void);
void complete_suspension_frames(or_fr_ptr);
void suspend_branch(void);
void resume_suspension_frame(susp_fr_ptr, or_fr_ptr);
#endif /* TABLING && YAPOR */
#endif /* YAPOR */
#endif /* TABLING */

6
OPTYap/opt.structs.h
View File

@ -149,9 +149,6 @@ struct global_locks {
int who_locked_heap;
lockvar heap_access;
lockvar alloc_block;
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
lockvar stderr_messages;
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
};
#endif /* YAPOR */
@ -279,7 +276,6 @@ struct global_data{
#define GLOBAL_LOCKS_who_locked_heap (GLOBAL.locks.who_locked_heap)
#define GLOBAL_LOCKS_heap_access (GLOBAL.locks.heap_access)
#define GLOBAL_LOCKS_alloc_block (GLOBAL.locks.alloc_block)
#define GLOBAL_LOCKS_stderr_messages (GLOBAL.locks.stderr_messages)
#define GLOBAL_branch(worker, depth) (GLOBAL.branch[worker][depth])
#define PARALLEL_EXECUTION_MODE (GLOBAL.parallel_execution_mode)
#define GLOBAL_answers (GLOBAL.answers)
@ -460,13 +456,11 @@ struct local_data{
#define REMOTE_top_susp_or_fr(worker) (REMOTE[worker].top_or_frame_with_suspensions)
#ifdef YAPOR
#include "or.structs.h"
#endif /* YAPOR */
#ifdef TABLING
#include "tab.structs.h"
#endif /* TABLING */

6
OPTYap/or.cowengine.c
View File

@ -121,11 +121,7 @@ int q_share_work(int worker_p) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
#ifdef YAPOR_ERRORS
if (OrFr_pend_prune_cp(LOCAL_top_or_fr) &&
BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("prune ltt > worker_p branch ltt (q_share_work)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(q_share_work, OrFr_pend_prune_cp(LOCAL_top_or_fr) && BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr));
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
LOCAL_prune_request = NULL;

10
OPTYap/or.cut.c
View File

@ -103,10 +103,7 @@ void prune_shared_branch(choiceptr prune_cp) {
SCH_update_local_or_tops();
} while (Get_LOCAL_top_cp() != prune_cp);
#ifdef YAPOR_ERRORS
if (Get_LOCAL_prune_request() && EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()))
YAPOR_ERROR_MESSAGE("EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp) (prune_shared_branch)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(prune_shared_branch, Get_LOCAL_prune_request() && EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()));
/* store answers not pruned */
if (qg_solutions)
CUT_join_answers_in_an_unique_frame(qg_solutions);
@ -193,10 +190,7 @@ void prune_shared_branch(choiceptr prune_cp) {
SCH_update_local_or_tops();
}
#ifdef YAPOR_ERRORS
if (Get_LOCAL_prune_request() && EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()))
YAPOR_ERROR_MESSAGE("EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, Get_LOCAL_top_cp()) (prune_shared_branch)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(prune_shared_branch, Get_LOCAL_prune_request() && EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()));
/* store answers not pruned */
if (qg_solutions)
CUT_join_answers_in_an_unique_frame(qg_solutions);

126
OPTYap/or.engine.c
View File

@ -203,11 +203,7 @@ int q_share_work(int worker_p) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
#ifdef YAPOR_ERRORS
if (Get_OrFr_pend_prune_cp(LOCAL_top_or_fr) &&
BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("prune ltt > worker_p branch ltt (q_share_work)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(q_share_work, Get_OrFr_pend_prune_cp(LOCAL_top_or_fr) && BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr));
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
LOCAL_prune_request = NULL;
@ -215,10 +211,7 @@ int q_share_work(int worker_p) {
/* unbind variables */
aux_tr = LOCAL_top_cp->cp_tr;
#ifdef TABLING_ERRORS
if (TR < aux_tr)
TABLING_ERROR_MESSAGE("TR < aux_tr (q_share_work)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr);
while (aux_tr != TR) {
aux_cell = TrailTerm(--TR);
/* check for global or local variables */
@ -230,12 +223,8 @@ int q_share_work(int worker_p) {
if (IN_BETWEEN(Yap_TrailBase, aux_cell, Yap_TrailTop)) {
/* avoid frozen segments */
TR = (tr_fr_ptr) aux_cell;
#ifdef TABLING_ERRORS
if (TR > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("TR > Yap_TrailTop (q_share_work)");
if (TR < aux_tr)
TABLING_ERROR_MESSAGE("TR < aux_tr (q_share_work)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(q_share_work, TR > (tr_fr_ptr) Yap_TrailTop);
TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr);
}
#endif /* TABLING */
#ifdef MULTI_ASSIGNMENT_VARIABLES
@ -247,16 +236,9 @@ int q_share_work(int worker_p) {
}
}
#ifdef OPTYAP_ERRORS
if (LOCAL_top_cp != LOCAL_top_cp_on_stack)
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp != LOCAL_top_cp_on_stack (q_share_work)");
if (YOUNGER_CP(B_FZ, LOCAL_top_cp))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(B_FZ, LOCAL_top_cp) (q_share_work)");
#endif /* OPTYAP_ERRORS */
#ifdef YAPOR_ERRORS
if (LOCAL_reply_signal != ready)
YAPOR_ERROR_MESSAGE("LOCAL_reply_signal != ready (q_share_work)");
#endif /* YAPOR_ERRORS */
OPTYAP_ERROR_CHECKING(q_share_work, LOCAL_top_cp != LOCAL_top_cp_on_stack);
OPTYAP_ERROR_CHECKING(q_share_work, YOUNGER_CP(B_FZ, LOCAL_top_cp));
YAPOR_ERROR_CHECKING(q_share_work, LOCAL_reply_signal != ready);
/* make sharing request */
LOCK_WORKER(worker_p);
@ -324,14 +306,9 @@ sync_with_p:
while (TR != aux_tr) {
aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) {
if (aux_cell < LOCAL_start_global_copy ||
EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) {
#ifdef YAPOR_ERRORS
if ((CELL *)aux_cell < H0)
YAPOR_ERROR_MESSAGE("aux_cell < H0 (q_share_work)");
if ((ADDR)aux_cell > Yap_LocalBase)
YAPOR_ERROR_MESSAGE("aux_cell > LocalBase (q_share_work)");
#endif /* YAPOR_ERRORS */
if (aux_cell < LOCAL_start_global_copy || EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) {
YAPOR_ERROR_CHECKING(q_share_work, (CELL *)aux_cell < H0);
YAPOR_ERROR_CHECKING(q_share_work, (ADDR)aux_cell > Yap_LocalBase);
#ifdef TABLING
*((CELL *) aux_cell) = TrailVal(aux_tr);
#else
@ -388,24 +365,16 @@ static
void share_private_nodes(int worker_q) {
choiceptr sharing_node = B;
#ifdef OPTYAP_ERRORS
if (YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack)) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack) (share_private_nodes)");
} else {
choiceptr aux_cp = B;
#ifdef DEBUG_OPTYAP
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack));
{ choiceptr aux_cp = B;
while (aux_cp != LOCAL_top_cp) {
if (YOUNGER_CP(LOCAL_top_cp, aux_cp)) {
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp not in branch (share_private_nodes)");
break;
}
if (EQUAL_OR_YOUNGER_CP(LOCAL_top_cp_on_stack, aux_cp)) {
OPTYAP_ERROR_MESSAGE("shared frozen segments in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(LOCAL_top_cp, aux_cp));
OPTYAP_ERROR_CHECKING(share_private_nodes, EQUAL_OR_YOUNGER_CP(LOCAL_top_cp_on_stack, aux_cp));
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
#ifdef TABLING
/* check if the branch is already shared */
@ -414,18 +383,15 @@ void share_private_nodes(int worker_q) {
sg_fr_ptr sg_frame;
dep_fr_ptr dep_frame;
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
{ or_fr_ptr aux_or_fr;
aux_or_fr = LOCAL_top_or_fr;
while (aux_or_fr != REMOTE_top_or_fr(worker_q)) {
if (YOUNGER_CP(OrFr_node(REMOTE_top_or_fr(worker_q)), OrFr_node(aux_or_fr))) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(OrFr_node(REMOTE_top_or_fr(worker_q)), OrFr_node(aux_or_fr)) (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(OrFr_node(REMOTE_top_or_fr(worker_q)), OrFr_node(aux_or_fr)));
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* update old shared nodes */
or_frame = LOCAL_top_or_fr;
@ -494,29 +460,22 @@ void share_private_nodes(int worker_q) {
while (sharing_node != LOCAL_top_cp) {
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (next_node_on_branch) {
choiceptr aux_cp = B;
while (aux_cp != next_node_on_branch) {
if (sharing_node == aux_cp)
OPTYAP_ERROR_MESSAGE("sharing_node on branch (share_private_nodes)");
if (YOUNGER_CP(next_node_on_branch, aux_cp)) {
OPTYAP_ERROR_MESSAGE("next_node_on_branch not in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, sharing_node == aux_cp);
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(next_node_on_branch, aux_cp));
aux_cp = aux_cp->cp_b;
}
} else {
choiceptr aux_cp = B;
while (aux_cp != sharing_node) {
if (YOUNGER_CP(sharing_node, aux_cp)) {
OPTYAP_ERROR_MESSAGE("sharing_node not in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(sharing_node, aux_cp));
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
ALLOC_OR_FRAME(or_frame);
if (previous_or_frame) {
@ -546,10 +505,7 @@ void share_private_nodes(int worker_q) {
#endif /* TABLING */
OrFr_members(or_frame) = bm_workers;
#ifdef YAPOR_ERRORS
if (sharing_node->cp_ap == GETWORK || sharing_node->cp_ap == GETWORK_SEQ)
YAPOR_ERROR_MESSAGE("choicepoint already shared (share_private_nodes)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(share_private_nodes, sharing_node->cp_ap == GETWORK || sharing_node->cp_ap == GETWORK_SEQ);
if (sharing_node->cp_ap && YAMOP_SEQ(sharing_node->cp_ap)) {
sharing_node->cp_ap = GETWORK_SEQ;
} else {
@ -579,10 +535,7 @@ void share_private_nodes(int worker_q) {
if (next_node_on_branch == sharing_node)
next_node_on_branch = NULL;
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
if (next_node_on_branch && YOUNGER_CP(next_node_on_branch, sharing_node))
OPTYAP_ERROR_MESSAGE("frozen node greater than next_node_on_branch (share_private_nodes)");
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_CHECKING(share_private_nodes, next_node_on_branch && YOUNGER_CP(next_node_on_branch, sharing_node));
}
/* initialize last or-frame pointer */
@ -625,20 +578,15 @@ void share_private_nodes(int worker_q) {
or_frame = OrFr_next_on_stack(or_frame);
}
#ifdef YAPOR_ERRORS
if (depth != OrFr_depth(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("incorrect depth value (share_private_nodes)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(share_private_nodes, depth != OrFr_depth(LOCAL_top_or_fr));
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
{ or_fr_ptr aux_or_fr = B->cp_or_fr;
choiceptr aux_cp;
while (aux_or_fr != LOCAL_top_cp_on_stack->cp_or_fr) {
aux_cp = OrFr_node(aux_or_fr);
if (OrFr_next(aux_or_fr) != aux_cp->cp_b->cp_or_fr)
OPTYAP_ERROR_MESSAGE("OrFr_next not in branch (share_private_nodes)");
if (OrFr_nearest_livenode(aux_or_fr) != aux_cp->cp_b->cp_or_fr)
OPTYAP_ERROR_MESSAGE("OrFr_nearest_livenode not in branch (share_private_nodes)");
OPTYAP_ERROR_CHECKING(share_private_nodes, OrFr_next(aux_or_fr) != aux_cp->cp_b->cp_or_fr);
OPTYAP_ERROR_CHECKING(share_private_nodes, OrFr_nearest_livenode(aux_or_fr) != aux_cp->cp_b->cp_or_fr);
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
aux_or_fr = B->cp_or_fr;
@ -646,16 +594,13 @@ void share_private_nodes(int worker_q) {
or_fr_ptr nearest_leftnode = OrFr_nearest_leftnode(aux_or_fr);
aux_cp = OrFr_node(aux_or_fr);
while (OrFr_node(nearest_leftnode) != aux_cp) {
if (YOUNGER_CP(OrFr_node(nearest_leftnode), aux_cp)) {
OPTYAP_ERROR_MESSAGE("OrFr_nearest_leftnode not in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(OrFr_node(nearest_leftnode), aux_cp));
aux_cp = aux_cp->cp_b;
}
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* update old shared nodes */
while (or_frame != REMOTE_top_or_fr(worker_q)) {
@ -711,7 +656,7 @@ void share_private_nodes(int worker_q) {
}
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
{ dep_fr_ptr aux_dep_fr = LOCAL_top_dep_fr;
while(aux_dep_fr != GLOBAL_root_dep_fr) {
choiceptr top_cp_on_branch;
@ -719,12 +664,11 @@ void share_private_nodes(int worker_q) {
while (YOUNGER_CP(top_cp_on_branch, B)) {
top_cp_on_branch = top_cp_on_branch->cp_b;
}
if (top_cp_on_branch->cp_or_fr != DepFr_top_or_fr(aux_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (share_private_nodes)");
OPTYAP_ERROR_CHECKING(share_private_nodes, top_cp_on_branch->cp_or_fr != DepFr_top_or_fr(aux_dep_fr));
aux_dep_fr = DepFr_next(aux_dep_fr);
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* update top shared nodes */
#ifdef TABLING

0
OPTYap/sbaamiops.h → OPTYap/or.sbaamiops.h
View File

6
OPTYap/or.sbaengine.c
View File

@ -152,11 +152,7 @@ int q_share_work(int worker_p) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
#ifdef YAPOR_ERRORS
if (OrFr_pend_prune_cp(LOCAL_top_or_fr) &&
BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("prune ltt > worker_p branch ltt (q_share_work)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(q_share_work, OrFr_pend_prune_cp(LOCAL_top_or_fr) && BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr));
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
LOCAL_prune_request = NULL;

0
OPTYap/sbaunify.h → OPTYap/or.sbaunify.h
View File

46
OPTYap/or.scheduler.c
View File

@ -100,10 +100,7 @@ void PUT_OUT_ROOT_NODE(int worker_num) {
static inline
void move_up_to_prune_request(void) {
#ifdef YAPOR_ERRORS
if (EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()))
YAPOR_ERROR_MESSAGE("invalid LOCAL_prune_request (move_up_to_prune_request)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(move_up_to_prune_request, EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()));
do {
LOCK_OR_FRAME(LOCAL_top_or_fr);
@ -268,15 +265,9 @@ int get_work(void) {
static
int move_up_one_node(or_fr_ptr nearest_livenode) {
#ifdef YAPOR_ERRORS
if (Get_LOCAL_prune_request() && EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()))
YAPOR_ERROR_MESSAGE("invalid LOCAL_prune_request (move_up_one_node)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(move_up_one_node, Get_LOCAL_prune_request() && EQUAL_OR_YOUNGER_CP(Get_LOCAL_prune_request(), Get_LOCAL_top_cp()));
LOCK_OR_FRAME(LOCAL_top_or_fr);
/* last worker in a sequential choicepoint ? */
if (OrFr_alternative(LOCAL_top_or_fr)
&& YAMOP_SEQ(OrFr_alternative(LOCAL_top_or_fr))
@ -285,7 +276,6 @@ int move_up_one_node(or_fr_ptr nearest_livenode) {
return FALSE;
}
/* pending prune ? */
if (Get_OrFr_pend_prune_cp(LOCAL_top_or_fr)
&& ! Get_LOCAL_prune_request()
@ -306,18 +296,9 @@ int move_up_one_node(or_fr_ptr nearest_livenode) {
return FALSE;
}
#ifdef OPTYAP_ERRORS
if (B_FZ != DepFr_cons_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("B_FZ != DepFr_cons_cp(LOCAL_top_dep_fr) (move_up_one_node)");
if (LOCAL_top_susp_or_fr) {
if (EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp(), B_FZ) && YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), LOCAL_top_cp))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), Get_LOCAL_top_cp()) (move_up_one_node)");
if (YOUNGER_CP(B_FZ, Get_LOCAL_top_cp()) && YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), B_FZ))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), B_FZ) (move_up_one_node)");
}
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_MESSAGE(move_up_one_node, B_FZ != DepFr_cons_cp(LOCAL_top_dep_fr));
OPTYAP_ERROR_MESSAGE(move_up_one_node, LOCAL_top_susp_or_fr && EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp(), B_FZ) && YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), LOCAL_top_cp));
OPTYAP_ERROR_MESSAGE(move_up_one_node, LOCAL_top_susp_or_fr && YOUNGER_CP(B_FZ, Get_LOCAL_top_cp()) && YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), B_FZ));
#ifdef TABLING
/* frozen stacks on branch ? */
@ -358,7 +339,6 @@ int move_up_one_node(or_fr_ptr nearest_livenode) {
return TRUE;
}
/* suspension frames to resume ? */
if (OrFr_suspensions(LOCAL_top_or_fr)) {
susp_fr_ptr resume_fr;
@ -386,7 +366,6 @@ int move_up_one_node(or_fr_ptr nearest_livenode) {
OrFr_nearest_suspnode(LOCAL_top_or_fr) = LOCAL_top_or_fr;
}
/* top node frozen ? */
if (B_FZ == Get_LOCAL_top_cp()) {
if (nearest_livenode)
@ -427,21 +406,13 @@ int move_up_one_node(or_fr_ptr nearest_livenode) {
return TRUE;
}
#ifdef OPTYAP_ERRORS
if (OrFr_alternative(LOCAL_top_or_fr) && ! YAMOP_SEQ(OrFr_alternative(LOCAL_top_or_fr)))
OPTYAP_ERROR_MESSAGE("OrFr_alternative(LOCAL_top_or_fr) not sequential (move_up_one_node)");
if (Get_LOCAL_top_cp() == DepFr_cons_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp == DepFr_cons_cp(LOCAL_top_dep_fr) (move_up_one_node)");
if (Get_LOCAL_top_cp() != Get_LOCAL_top_cp_on_stack())
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp != LOCAL_top_cp_on_stack (move_up_one_node)");
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_MESSAGE(move_up_one_node, OrFr_alternative(LOCAL_top_or_fr) && ! YAMOP_SEQ(OrFr_alternative(LOCAL_top_or_fr)));
OPTYAP_ERROR_MESSAGE(move_up_one_node, Get_LOCAL_top_cp() == DepFr_cons_cp(LOCAL_top_dep_fr));
OPTYAP_ERROR_MESSAGE(move_up_one_node, Get_LOCAL_top_cp() != Get_LOCAL_top_cp_on_stack());
/* no frozen nodes */
Set_LOCAL_top_cp_on_stack(GetOrFr_node(OrFr_next_on_stack(LOCAL_top_or_fr)));
/* no more owners ? */
if (OrFr_owners(LOCAL_top_or_fr) == 1) {
if (OrFr_suspensions(LOCAL_top_or_fr)) {
@ -500,7 +471,6 @@ int move_up_one_node(or_fr_ptr nearest_livenode) {
return TRUE;
}
/* more owners */
if (nearest_livenode)
OrFr_nearest_livenode(LOCAL_top_or_fr) = nearest_livenode;

103
OPTYap/or.threadengine.c
View File

@ -146,26 +146,15 @@ int q_share_work(int worker_p) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
#ifdef YAPOR_ERRORS
if (Get_OrFr_pend_prune_cp(LOCAL_top_or_fr) &&
BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("prune ltt > worker_p branch ltt (q_share_work)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(q_share_work, Get_OrFr_pend_prune_cp(LOCAL_top_or_fr) && BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr));
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
Set_LOCAL_prune_request(NULL);
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
#ifdef OPTYAP_ERRORS
if (Get_LOCAL_top_cp() != Get_LOCAL_top_cp_on_stack())
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp != LOCAL_top_cp_on_stack (q_share_work)");
if (YOUNGER_CP(B_FZ, Get_LOCAL_top_cp()))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(B_FZ, LOCAL_top_cp) (q_share_work)");
#endif /* OPTYAP_ERRORS */
#ifdef YAPOR_ERRORS
if (LOCAL_reply_signal != worker_ready)
YAPOR_ERROR_MESSAGE("LOCAL_reply_signal != worker_ready (q_share_work)");
#endif /* YAPOR_ERRORS */
OPTYAP_ERROR_MESSAGE(q_share_work, Get_LOCAL_top_cp() != Get_LOCAL_top_cp_on_stack());
OPTYAP_ERROR_MESSAGE(q_share_work, YOUNGER_CP(B_FZ, Get_LOCAL_top_cp()));
YAPOR_ERROR_CHECKING(q_share_work, LOCAL_reply_signal != worker_ready);
/* make sharing request */
LOCK_WORKER(worker_p);
@ -213,24 +202,17 @@ static
void share_private_nodes(int worker_q) {
choiceptr sharing_node = B;
#ifdef OPTYAP_ERRORS
if (YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack())) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack) (share_private_nodes)");
} else {
choiceptr aux_cp = B;
#ifdef DEBUG_OPTYAP
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack()));
{ choiceptr aux_cp = B;
while (aux_cp != Get_LOCAL_top_cp()) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp not in branch (share_private_nodes)");
break;
}
if (EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("shared frozen segments in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp));
OPTYAP_ERROR_CHECKING(share_private_nodes, EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp));
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
#ifdef TABLING
/* check if the branch is already shared */
@ -239,18 +221,15 @@ void share_private_nodes(int worker_q) {
sg_fr_ptr sg_frame;
dep_fr_ptr dep_frame;
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
{ or_fr_ptr aux_or_fr;
aux_or_fr = LOCAL_top_or_fr;
while (aux_or_fr != REMOTE_top_or_fr(worker_q)) {
if (YOUNGER_CP(GetOrFr_node(REMOTE_top_or_fr(worker_q)), GetOrFr_node(aux_or_fr))) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(GetOrFr_node(REMOTE_top_or_fr(worker_q)), OrFr_node(aux_or_fr)) (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(GetOrFr_node(REMOTE_top_or_fr(worker_q)), GetOrFr_node(aux_or_fr)));
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* update old shared nodes */
or_frame = LOCAL_top_or_fr;
@ -320,29 +299,22 @@ void share_private_nodes(int worker_q) {
while (sharing_node != Get_LOCAL_top_cp()) {
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (next_node_on_branch) {
choiceptr aux_cp = B;
while (aux_cp != next_node_on_branch) {
if (sharing_node == aux_cp)
OPTYAP_ERROR_MESSAGE("sharing_node on branch (share_private_nodes)");
if (YOUNGER_CP(next_node_on_branch, aux_cp)) {
OPTYAP_ERROR_MESSAGE("next_node_on_branch not in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, sharing_node == aux_cp);
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(next_node_on_branch, aux_cp));
aux_cp = aux_cp->cp_b;
}
} else {
choiceptr aux_cp = B;
while (aux_cp != sharing_node) {
if (YOUNGER_CP(sharing_node, aux_cp)) {
OPTYAP_ERROR_MESSAGE("sharing_node not in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(sharing_node, aux_cp));
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
ALLOC_OR_FRAME(or_frame);
if (previous_or_frame) {
@ -372,10 +344,7 @@ void share_private_nodes(int worker_q) {
#endif /* TABLING */
OrFr_members(or_frame) = bm_workers;
#ifdef YAPOR_ERRORS
if (sharing_node->cp_ap == GETWORK || sharing_node->cp_ap == GETWORK_SEQ)
YAPOR_ERROR_MESSAGE("choicepoint already shared (share_private_nodes)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(share_private_nodes, sharing_node->cp_ap == GETWORK || sharing_node->cp_ap == GETWORK_SEQ);
if (sharing_node->cp_ap && YAMOP_SEQ(sharing_node->cp_ap)) {
sharing_node->cp_ap = GETWORK_SEQ;
} else {
@ -405,10 +374,7 @@ void share_private_nodes(int worker_q) {
if (next_node_on_branch == sharing_node)
next_node_on_branch = NULL;
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
if (next_node_on_branch && YOUNGER_CP(next_node_on_branch, sharing_node))
OPTYAP_ERROR_MESSAGE("frozen node greater than next_node_on_branch (share_private_nodes)");
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_MESSAGE(share_private_nodes, next_node_on_branch && YOUNGER_CP(next_node_on_branch, sharing_node));
}
/* initialize last or-frame pointer */
@ -451,20 +417,15 @@ void share_private_nodes(int worker_q) {
or_frame = OrFr_next_on_stack(or_frame);
}
#ifdef YAPOR_ERRORS
if (depth != OrFr_depth(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("incorrect depth value (share_private_nodes)");
#endif /* YAPOR_ERRORS */
YAPOR_ERROR_CHECKING(share_private_nodes, depth != OrFr_depth(LOCAL_top_or_fr));
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
{ or_fr_ptr aux_or_fr = B->cp_or_fr;
choiceptr aux_cp;
while (aux_or_fr != Get_LOCAL_top_cp_on_stack()->cp_or_fr) {
aux_cp = GetOrFr_node(aux_or_fr);
if (OrFr_next(aux_or_fr) != aux_cp->cp_b->cp_or_fr)
OPTYAP_ERROR_MESSAGE("OrFr_next not in branch (share_private_nodes)");
if (OrFr_nearest_livenode(aux_or_fr) != aux_cp->cp_b->cp_or_fr)
OPTYAP_ERROR_MESSAGE("OrFr_nearest_livenode not in branch (share_private_nodes)");
OPTYAP_ERROR_CHECKING(share_private_nodes, OrFr_next(aux_or_fr) != aux_cp->cp_b->cp_or_fr);
OPTYAP_ERROR_CHECKING(share_private_nodes, OrFr_nearest_livenode(aux_or_fr) != aux_cp->cp_b->cp_or_fr);
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
aux_or_fr = B->cp_or_fr;
@ -472,16 +433,13 @@ void share_private_nodes(int worker_q) {
or_fr_ptr nearest_leftnode = OrFr_nearest_leftnode(aux_or_fr);
aux_cp = GetOrFr_node(aux_or_fr);
while (GetOrFr_node(nearest_leftnode) != aux_cp) {
if (YOUNGER_CP(GetOrFr_node(nearest_leftnode), aux_cp)) {
OPTYAP_ERROR_MESSAGE("OrFr_nearest_leftnode not in branch (share_private_nodes)");
break;
}
OPTYAP_ERROR_CHECKING(share_private_nodes, YOUNGER_CP(GetOrFr_node(nearest_leftnode), aux_cp));
aux_cp = aux_cp->cp_b;
}
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* update old shared nodes */
while (or_frame != REMOTE_top_or_fr(worker_q)) {
@ -537,7 +495,7 @@ void share_private_nodes(int worker_q) {
}
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
{ dep_fr_ptr aux_dep_fr = LOCAL_top_dep_fr;
while(aux_dep_fr != GLOBAL_root_dep_fr) {
choiceptr top_cp_on_branch;
@ -545,12 +503,11 @@ void share_private_nodes(int worker_q) {
while (YOUNGER_CP(top_cp_on_branch, B)) {
top_cp_on_branch = top_cp_on_branch->cp_b;
}
if (top_cp_on_branch->cp_or_fr != DepFr_top_or_fr(aux_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (share_private_nodes)");
OPTYAP_ERROR_CHECKING(share_private_nodes, top_cp_on_branch->cp_or_fr != DepFr_top_or_fr(aux_dep_fr));
aux_dep_fr = DepFr_next(aux_dep_fr);
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* update top shared nodes */
#ifdef TABLING

95
OPTYap/tab.suspend.c → OPTYap/tab.completion.c
View File

@ -11,18 +11,18 @@
** **
************************************************************************/
/************************************
** Includes & Prototypes **
************************************/
/***********************
** Includes **
***********************/
#include "Yap.h"
#if defined(TABLING) && defined(YAPOR)
#ifdef TABLING
#include "Yatom.h"
#include "YapHeap.h"
#include "tab.macros.h"
#ifdef YAPOR
#include "or.macros.h"
static void complete_suspension_branch(susp_fr_ptr, choiceptr, or_fr_ptr *, dep_fr_ptr *);
#endif /* YAPOR */
@ -30,6 +30,7 @@ static void complete_suspension_branch(susp_fr_ptr, choiceptr, or_fr_ptr *, dep_
** Local functions **
******************************/
#ifdef YAPOR
static void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or_fr_ptr *chain_or_fr, dep_fr_ptr *chain_dep_fr) {
or_fr_ptr aux_or_fr;
sg_fr_ptr aux_sg_fr;
@ -76,10 +77,7 @@ static void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or
while (IS_UNLOCKED(OrFr_lock(aux_or_fr))) {
susp_fr_ptr aux_susp_fr;
or_fr_ptr next_or_fr_on_stack;
#ifdef OPTYAP_ERRORS
if (YOUNGER_CP(top_cp, GetOrFr_node(aux_or_fr)))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(top_cp, GetOrFr_node(aux_or_fr)) (complete_suspension_branch)");
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_CHECKING(complete_suspension_branch, YOUNGER_CP(top_cp, GetOrFr_node(aux_or_fr)));
LOCK_OR_FRAME(aux_or_fr);
aux_susp_fr = OrFr_suspensions(aux_or_fr);
while (aux_susp_fr) {
@ -97,6 +95,7 @@ static void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or
return;
}
#endif /* YAPOR */
@ -104,6 +103,44 @@ static void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or
** Global functions **
*******************************/
void private_completion(sg_fr_ptr sg_fr) {
/* complete subgoals */
#ifdef LIMIT_TABLING
sg_fr_ptr aux_sg_fr;
while (LOCAL_top_sg_fr != sg_fr) {
aux_sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(aux_sg_fr);
mark_as_completed(aux_sg_fr);
insert_into_global_sg_fr_list(aux_sg_fr);
}
aux_sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(aux_sg_fr);
mark_as_completed(aux_sg_fr);
insert_into_global_sg_fr_list(aux_sg_fr);
#else
while (LOCAL_top_sg_fr != sg_fr) {
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
#endif /* LIMIT_TABLING */
/* release dependency frames */
while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) { /* never equal if batched scheduling */
dep_fr_ptr dep_fr = DepFr_next(LOCAL_top_dep_fr);
FREE_DEPENDENCY_FRAME(LOCAL_top_dep_fr);
LOCAL_top_dep_fr = dep_fr;
}
/* adjust freeze registers */
adjust_freeze_registers();
return;
}
#ifdef YAPOR
void public_completion(void) {
dep_fr_ptr chain_dep_fr, next_dep_fr;
or_fr_ptr chain_or_fr, top_or_fr, next_or_fr;
@ -285,24 +322,17 @@ void suspend_branch(void) {
/* suspension only occurs in shared nodes that **
** are leaders with younger consumer nodes */
#ifdef OPTYAP_ERRORS
if (Get_LOCAL_top_cp()->cp_or_fr != LOCAL_top_or_fr)
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp->cp_or_fr != LOCAL_top_or_fr (suspend_branch)");
if (B_FZ == Get_LOCAL_top_cp())
OPTYAP_ERROR_MESSAGE("B_FZ = LOCAL_top_cp (suspend_branch)");
if (YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack()))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack) (suspend_branch)");
if (Get_LOCAL_top_cp()->cp_or_fr != LOCAL_top_or_fr)
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp->cp_or_fr != LOCAL_top_or_fr (suspend_branch)");
#ifdef DEBUG_OPTYAP
OPTYAP_ERROR_CHECKING(suspend_branch, Get_LOCAL_top_cp()->cp_or_fr != LOCAL_top_or_fr);
OPTYAP_ERROR_CHECKING(suspend_branch, B_FZ == Get_LOCAL_top_cp());
OPTYAP_ERROR_CHECKING(suspend_branch, YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack()));
OPTYAP_ERROR_CHECKING(suspend_branch, Get_LOCAL_top_cp()->cp_or_fr != LOCAL_top_or_fr);
or_frame = Get_LOCAL_top_cp_on_stack()->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), GetOrFr_node(or_frame))) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, GetOrFr_node(or_frame)) (suspend_branch)");
break;
}
OPTYAP_ERROR_CHECKING(suspend_branch, YOUNGER_CP(Get_LOCAL_top_cp(), GetOrFr_node(or_frame)));
or_frame = OrFr_next_on_stack(or_frame);
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
or_frame = Get_LOCAL_top_cp_on_stack()->cp_or_fr;
LOCK_OR_FRAME(or_frame);
@ -378,16 +408,10 @@ void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr) {
SuspFr_trail_start(resume_fr),
SuspFr_trail_size(resume_fr));
#ifdef OPTYAP_ERRORS
if (DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr))->cp_h != SuspFr_global_reg(resume_fr) + SuspFr_global_size(resume_fr))
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr)->cp_h != SuspFr_global_reg + SuspFr_global_size (resume_suspension_frame)");
if (DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr))->cp_tr != SuspFr_trail_reg(resume_fr) + SuspFr_trail_size(resume_fr))
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr)->cp_tr != SuspFr_trail_reg + SuspFr_trail_size (resume_suspension_frame)");
if (DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)) != SuspFr_local_reg(resume_fr))
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr) != SuspFr_local_reg (resume_suspension_frame)");
if ((void *)Get_LOCAL_top_cp() < SuspFr_local_reg(resume_fr) + SuspFr_local_size(resume_fr))
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp < SuspFr_local_reg + SuspFr_local_size (resume_suspension_frame)");
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_CHECKING(resume_suspension_frame, DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr))->cp_h != SuspFr_global_reg(resume_fr) + SuspFr_global_size(resume_fr));
OPTYAP_ERROR_CHECKING(resume_suspension_frame, DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr))->cp_tr != SuspFr_trail_reg(resume_fr) + SuspFr_trail_size(resume_fr));
OPTYAP_ERROR_CHECKING(resume_suspension_frame, DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)) != SuspFr_local_reg(resume_fr));
OPTYAP_ERROR_CHECKING(resume_suspension_frame, (void *)Get_LOCAL_top_cp() < SuspFr_local_reg(resume_fr) + SuspFr_local_size(resume_fr));
/* update shared nodes */
or_frame = top_or_fr;
@ -426,4 +450,5 @@ void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr) {
return;
}
#endif /* TABLING && YAPOR */
#endif /* YAPOR */
#endif /* TABLING */

314
OPTYap/tab.insts.i
View File

@ -16,25 +16,15 @@
************************************************************************/
#ifdef LOW_LEVEL_TRACER
#define store_low_level_trace_info(CP, TAB_ENT) CP->cp_pred_entry = TabEnt_pe(TAB_ENT)
#define store_low_level_trace_info(CP, TAB_ENT) \
CP->cp_pred_entry = TabEnt_pe(TAB_ENT)
#else
#define store_low_level_trace_info(CP, TAB_ENT)
#endif /* LOW_LEVEL_TRACER */
#ifdef TABLING_ERRORS
#define TABLING_ERRORS_check_stack \
if (Unsigned(H) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H + 1024 > B (check_stack)"); \
if (Unsigned(H_FZ) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H_FZ + 1024 > B (check_stack)")
#define TABLING_ERRORS_consume_answer_and_procceed \
if (IS_BATCHED_GEN_CP(B)) \
TABLING_ERROR_MESSAGE("IS_BATCHED_GEN_CP(B) (consume_answer_and_procceed)")
#else
#define TABLING_ERRORS_check_stack
#define TABLING_ERRORS_consume_answer_and_procceed
#endif /* TABLING_ERRORS */
#define TABLING_ERROR_CHECKING_STACK \
TABLING_ERROR_CHECKING(store_node, Unsigned(H) + 1024 > Unsigned(B)); \
TABLING_ERROR_CHECKING(store_node, Unsigned(H_FZ) + 1024 > Unsigned(B))
#define store_generator_node(TAB_ENT, SG_FR, ARITY, AP) \
@ -83,7 +73,7 @@
B = gcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
TABLING_ERROR_CHECKING_STACK; \
}
@ -107,7 +97,7 @@
B = gcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
TABLING_ERROR_CHECKING_STACK; \
}
#endif /* DETERMINISTIC_TABLING */
@ -188,34 +178,34 @@
B = ccp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
TABLING_ERROR_CHECKING_STACK; \
}
#define consume_answer_and_procceed(DEP_FR, ANSWER) \
{ CELL *subs_ptr; \
/* restore consumer choice point */ \
H = HBREG = PROTECT_FROZEN_H(B); \
restore_yaam_reg_cpdepth(B); \
CPREG = B->cp_cp; \
ENV = B->cp_env; \
/* set_cut(YENV, B->cp_b); --> no effect */ \
PREG = (yamop *) CPREG; \
PREFETCH_OP(PREG); \
/* load answer from table to global stack */ \
if (B == DepFr_leader_cp(DEP_FR)) { \
/* B is a generator-consumer node */ \
/* never here if batched scheduling */ \
TABLING_ERRORS_consume_answer_and_procceed; \
subs_ptr = (CELL *) (GEN_CP(B) + 1); \
subs_ptr += SgFr_arity(GEN_CP(B)->cp_sg_fr); \
} else { \
subs_ptr = (CELL *) (CONS_CP(B) + 1); \
} \
load_answer(ANSWER, subs_ptr); \
/* procceed */ \
YENV = ENV; \
GONext(); \
#define consume_answer_and_procceed(DEP_FR, ANSWER) \
{ CELL *subs_ptr; \
/* restore consumer choice point */ \
H = HBREG = PROTECT_FROZEN_H(B); \
restore_yaam_reg_cpdepth(B); \
CPREG = B->cp_cp; \
ENV = B->cp_env; \
/* set_cut(YENV, B->cp_b); --> no effect */ \
PREG = (yamop *) CPREG; \
PREFETCH_OP(PREG); \
/* load answer from table to global stack */ \
if (B == DepFr_leader_cp(DEP_FR)) { \
/* B is a generator-consumer node */ \
/* never here if batched scheduling */ \
TABLING_ERROR_CHECKING(generator_consumer, IS_BATCHED_GEN_CP(B)); \
subs_ptr = (CELL *) (GEN_CP(B) + 1); \
subs_ptr += SgFr_arity(GEN_CP(B)->cp_sg_fr); \
} else { \
subs_ptr = (CELL *) (CONS_CP(B) + 1); \
} \
load_answer(ANSWER, subs_ptr); \
/* procceed */ \
YENV = ENV; \
GONext(); \
}
@ -238,7 +228,7 @@
B = lcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
TABLING_ERROR_CHECKING_STACK; \
}
@ -451,21 +441,19 @@
UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(tab_ent, sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
aux_cp = B;
while (YOUNGER_CP(aux_cp, Get_LOCAL_top_cp_on_stack()))
aux_cp = aux_cp->cp_b;
if (aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (table_try_single)");
OPTYAP_ERROR_CHECKING(table_try_single, aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr));
aux_cp = B;
while (YOUNGER_CP(aux_cp, DepFr_leader_cp(LOCAL_top_dep_fr)))
aux_cp = aux_cp->cp_b;
if (aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_leader_cp (table_try_single)");
OPTYAP_ERROR_CHECKING(table_try_single, aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr));
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
goto answer_resolution;
} else {
/* subgoal completed */
@ -564,21 +552,19 @@
UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(tab_ent, sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
aux_cp = B;
while (YOUNGER_CP(aux_cp, Get_LOCAL_top_cp_on_stack()))
aux_cp = aux_cp->cp_b;
if (aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (table_try_me)");
OPTYAP_ERROR_CHECKING(table_try_me, aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr));
aux_cp = B;
while (YOUNGER_CP(aux_cp, DepFr_leader_cp(LOCAL_top_dep_fr)))
aux_cp = aux_cp->cp_b;
if (aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_leader_cp (table_try_me)");
OPTYAP_ERROR_CHECKING(table_try_me, aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr));
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
goto answer_resolution;
} else {
/* subgoal completed */
@ -677,21 +663,19 @@
UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(tab_ent, sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
aux_cp = B;
while (YOUNGER_CP(aux_cp, Get_LOCAL_top_cp_on_stack()))
aux_cp = aux_cp->cp_b;
if (aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (table_try)");
OPTYAP_ERROR_CHECKING(table_try, aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr));
aux_cp = B;
while (YOUNGER_CP(aux_cp, DepFr_leader_cp(LOCAL_top_dep_fr)))
aux_cp = aux_cp->cp_b;
if (aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_leader_cp (table_try)");
OPTYAP_ERROR_CHECKING(table_try, aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr));
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
goto answer_resolution;
} else {
/* subgoal completed */
@ -861,7 +845,7 @@
sg_fr = GEN_CP(gcp)->cp_sg_fr;
subs_ptr = (CELL *)(GEN_CP(gcp) + 1) + PREG->u.s.s;
}
#if defined(TABLING_ERRORS) && !defined(DETERMINISTIC_TABLING)
#if defined(DEBUG_TABLING) && !defined(DETERMINISTIC_TABLING)
{
int i, j, arity_args, arity_subs;
CELL *aux_args;
@ -877,11 +861,10 @@
Term term_arg = Deref(*(aux_args + j));
if (term_subs == term_arg) break;
}
if (j == arity_args)
TABLING_ERROR_MESSAGE("j == arity_args (table_new_answer)");
TABLING_ERROR_CHECKING(table_new_answer, j == arity_args);
}
}
#endif /* TABLING_ERRORS && !DETERMINISTIC_TABLING */
#endif /* DEBUG_TABLING && !DETERMINISTIC_TABLING */
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
LOCK(SgFr_lock(sg_fr));
#endif /* TABLE_LOCK_LEVEL */
@ -1032,16 +1015,15 @@
else
TrNode_child(SgFr_last_answer(sg_fr)) = ans_node;
SgFr_last_answer(sg_fr) = ans_node;
#ifdef TABLING_ERRORS
#ifdef DEBUG_TABLING
{
ans_node_ptr aux_ans_node = SgFr_first_answer(sg_fr);
while (aux_ans_node != SgFr_last_answer(sg_fr)) {
if (! IS_ANSWER_LEAF_NODE(aux_ans_node))
TABLING_ERROR_MESSAGE("! IS_ANSWER_LEAF_NODE(aux_ans_node) (table_new_answer)");
TABLING_ERROR_CHECKING(table_new_answer, !IS_ANSWER_LEAF_NODE(aux_ans_node));
aux_ans_node = TrNode_child(aux_ans_node);
}
}
#endif /* TABLING_ERRORS */
#endif /* DEBUG_TABLING */
UNLOCK(SgFr_lock(sg_fr));
if (IS_BATCHED_GEN_CP(gcp)) {
#ifdef TABLING_EARLY_COMPLETION
@ -1116,15 +1098,8 @@
dep_fr_ptr dep_fr;
ans_node_ptr ans_node;
#ifdef OPTYAP_ERRORS
if (SCH_top_shared_cp(B)) {
if (B->cp_or_fr->alternative != ANSWER_RESOLUTION)
OPTYAP_ERROR_MESSAGE("B->cp_or_fr->alternative != ANSWER_RESOLUTION (answer_resolution)");
} else {
if (B->cp_ap != ANSWER_RESOLUTION)
OPTYAP_ERROR_MESSAGE("B->cp_ap != ANSWER_RESOLUTION (answer_resolution)");
}
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_CHECKING(answer_resolution, SCH_top_shared_cp(B) && B->cp_or_fr->alternative != ANSWER_RESOLUTION);
OPTYAP_ERROR_CHECKING(answer_resolution, !SCH_top_shared_cp(B) && B->cp_ap != ANSWER_RESOLUTION);
dep_fr = CONS_CP(B)->cp_dep_fr;
LOCK(DepFr_lock(dep_fr));
ans_node = DepFr_last_answer(dep_fr);
@ -1140,10 +1115,7 @@
if (B == DepFr_leader_cp(LOCAL_top_dep_fr)) {
/* B is a generator-consumer node **
** never here if batched scheduling */
#ifdef TABLING_ERRORS
if (IS_BATCHED_GEN_CP(B))
TABLING_ERROR_MESSAGE("IS_BATCHED_GEN_CP(B) (answer_resolution)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(answer_resolution, IS_BATCHED_GEN_CP(B));
goto completion;
}
#endif /* YAPOR */
@ -1170,12 +1142,8 @@
chain_cp = DepFr_leader_cp(LOCAL_top_dep_fr);
if (YOUNGER_CP(top_chain_cp, chain_cp))
chain_cp = top_chain_cp;
#ifdef TABLING_ERRORS
if (EQUAL_OR_YOUNGER_CP(top_chain_cp, B))
TABLING_ERROR_MESSAGE("EQUAL_OR_YOUNGER_CP(top_chain_cp, B) (answer_resolution)");
else if (EQUAL_OR_YOUNGER_CP(chain_cp, B))
TABLING_ERROR_MESSAGE("EQUAL_OR_YOUNGER_CP(chain_cp, B) (answer_resolution)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(answer_resolution, EQUAL_OR_YOUNGER_CP(top_chain_cp, B));
TABLING_ERROR_CHECKING(answer_resolution, EQUAL_OR_YOUNGER_CP(chain_cp, B));
/* check for dependency frames with unconsumed answers */
dep_fr = DepFr_next(dep_fr);
@ -1244,37 +1212,22 @@
pruning_over_tabling_data_structures();
}
#endif /* YAPOR */
#ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack())) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(Get_LOCAL_top_cp(), LOCAL_top_cp_on_stack) (answer_resolution)");
} else {
choiceptr aux_cp;
aux_cp = chain_cp;
while (aux_cp != Get_LOCAL_top_cp()) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp not in branch (answer_resolution)");
break;
}
if (EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("shared frozen segments in branch (answer_resolution)");
break;
}
aux_cp = aux_cp->cp_b;
}
}
#ifdef DEBUG_OPTYAP
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
OPTYAP_ERROR_CHECKING(completion, YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack()));
aux_cp = chain_cp;
while (aux_cp != Get_LOCAL_top_cp()) {
OPTYAP_ERROR_CHECKING(completion, YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp));
OPTYAP_ERROR_CHECKING(completion, EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp));
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* restore bindings, update registers, consume answer and procceed */
restore_bindings(B->cp_tr, chain_cp->cp_tr);
#ifdef TABLING_ERRORS
if (TR != B->cp_tr) {
if(! IsPairTerm((CELL)TrailTerm(TR - 1)))
TABLING_ERROR_MESSAGE("! IsPairTerm((CELL)TrailTerm(TR - 1)) (answer_resolution)");
if ((tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr)
TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (answer_resolution)");
}
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(answer_resolution, TR != B->cp_tr && !IsPairTerm((CELL)TrailTerm(TR - 1)));
TABLING_ERROR_CHECKING(answer_resolution, TR != B->cp_tr && (tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr);
B = chain_cp;
TR = TR_FZ;
TRAIL_LINK(B->cp_tr);
@ -1330,37 +1283,22 @@
}
}
#endif /* YAPOR */
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (PARALLEL_EXECUTION_MODE) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack())) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack()) (answer_resolution)");
} else {
choiceptr aux_cp;
aux_cp = chain_cp;
while (aux_cp != Get_LOCAL_top_cp()) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp not in branch (answer_resolution)");
break;
}
if (EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("shared frozen segments in branch (answer_resolution)");
break;
}
aux_cp = aux_cp->cp_b;
}
choiceptr aux_cp;
OPTYAP_ERROR_CHECKING(completion, YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack()));
aux_cp = chain_cp;
while (aux_cp != Get_LOCAL_top_cp()) {
OPTYAP_ERROR_CHECKING(completion, YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp));
OPTYAP_ERROR_CHECKING(completion, EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp));
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* unbind variables */
unbind_variables(B->cp_tr, chain_cp->cp_tr);
#ifdef TABLING_ERRORS
if (TR != B->cp_tr) {
if(! IsPairTerm((CELL)TrailTerm(TR - 1)))
TABLING_ERROR_MESSAGE("! IsPairTerm((CELL)TrailTerm(TR - 1)) (answer_resolution)");
if ((tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr)
TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (answer_resolution)");
}
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(answer_resolution, TR != B->cp_tr && !IsPairTerm((CELL)TrailTerm(TR - 1)));
TABLING_ERROR_CHECKING(answer_resolution, TR != B->cp_tr && (tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr);
if (DepFr_leader_cp(LOCAL_top_dep_fr) == chain_cp && (
/* chain_cp is a leader node AND ... */
#ifdef YAPOR
@ -1470,20 +1408,16 @@
}
UNLOCK(DepFr_lock(dep_fr));
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (PARALLEL_EXECUTION_MODE) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack())) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack) (completion)");
} else {
choiceptr aux_cp;
aux_cp = DepFr_cons_cp(dep_fr);
while (YOUNGER_CP(aux_cp, Get_LOCAL_top_cp_on_stack()))
aux_cp = aux_cp->cp_b;
if (aux_cp->cp_or_fr != DepFr_top_or_fr(dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (completion)");
}
choiceptr aux_cp;
OPTYAP_ERROR_CHECKING(completion, Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack());
aux_cp = DepFr_cons_cp(dep_fr);
while (YOUNGER_CP(aux_cp, Get_LOCAL_top_cp_on_stack()))
aux_cp = aux_cp->cp_b;
OPTYAP_ERROR_CHECKING(completion, aux_cp->cp_or_fr != DepFr_top_or_fr(dep_fr));
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
#ifdef YAPOR
/* update shared nodes */
if (YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), Get_LOCAL_top_cp())) {
@ -1499,43 +1433,24 @@
Set_LOCAL_top_cp(GetOrFr_node(LOCAL_top_or_fr));
}
#endif /* YAPOR */
#ifdef OPTYAP_ERRORS
#ifdef DEBUG_OPTYAP
if (PARALLEL_EXECUTION_MODE) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack())) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack) (completion)");
} else {
choiceptr aux_cp;
aux_cp = DepFr_cons_cp(dep_fr);
while (aux_cp != Get_LOCAL_top_cp()) {
if (YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp not in branch (completion)");
break;
}
if (EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp)) {
OPTYAP_ERROR_MESSAGE("shared frozen segments in branch (completion)");
break;
}
aux_cp = aux_cp->cp_b;
}
}
choiceptr aux_cp;
OPTYAP_ERROR_CHECKING(completion, YOUNGER_CP(Get_LOCAL_top_cp(), Get_LOCAL_top_cp_on_stack()));
aux_cp = DepFr_cons_cp(dep_fr);
while (aux_cp != Get_LOCAL_top_cp()) {
OPTYAP_ERROR_CHECKING(completion, YOUNGER_CP(Get_LOCAL_top_cp(), aux_cp));
OPTYAP_ERROR_CHECKING(completion, EQUAL_OR_YOUNGER_CP(Get_LOCAL_top_cp_on_stack(), aux_cp));
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#endif /* DEBUG_OPTYAP */
/* rebind variables, update registers, consume answer and procceed */
#ifdef TABLING_ERRORS
if (EQUAL_OR_YOUNGER_CP(B, DepFr_cons_cp(dep_fr)))
TABLING_ERROR_MESSAGE("EQUAL_OR_YOUNGER_CP(B, DepFr_cons_cp(dep_fr)) (completion)");
if (B->cp_tr > DepFr_cons_cp(dep_fr)->cp_tr)
TABLING_ERROR_MESSAGE("B->cp_tr > DepFr_cons_cp(dep_fr)->cp_tr (completion)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(completion, EQUAL_OR_YOUNGER_CP(B, DepFr_cons_cp(dep_fr)));
TABLING_ERROR_CHECKING(completion, B->cp_tr > DepFr_cons_cp(dep_fr)->cp_tr);
rebind_variables(DepFr_cons_cp(dep_fr)->cp_tr, B->cp_tr);
#ifdef TABLING_ERRORS
if (TR != B->cp_tr) {
if(! IsPairTerm((CELL)TrailTerm(TR - 1)))
TABLING_ERROR_MESSAGE("! IsPairTerm((CELL)TrailTerm(TR - 1)) (completion)");
if ((tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr)
TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (completion)");
}
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(completion, TR != B->cp_tr && !IsPairTerm((CELL)TrailTerm(TR - 1)));
TABLING_ERROR_CHECKING(completion, TR != B->cp_tr && (tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr);
B = DepFr_cons_cp(dep_fr);
TR = TR_FZ;
if (TR != B->cp_tr)
@ -1622,22 +1537,13 @@
/* complete all */
public_completion();
}
#ifdef TABLING_ERRORS
if (TR != B->cp_tr) {
if(! IsPairTerm((CELL)TrailTerm(TR - 1)))
TABLING_ERROR_MESSAGE("! IsPairTerm((CELL)TrailTerm(TR - 1)) (completion)");
if ((tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr)
TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (completion)");
}
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(completion, TR != B->cp_tr && !IsPairTerm((CELL)TrailTerm(TR - 1)));
TABLING_ERROR_CHECKING(completion, TR != B->cp_tr && (tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr);
if (B == DepFr_leader_cp(LOCAL_top_dep_fr)) {
/* B is a generator-consumer node */
/* never here if batched scheduling */
ans_node_ptr ans_node;
#ifdef TABLING_ERRORS
if (IS_BATCHED_GEN_CP(B))
TABLING_ERROR_MESSAGE("IS_BATCHED_GEN_CP(B) (completion)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(completion, IS_BATCHED_GEN_CP(B));
TR = B->cp_tr;
SET_BB(B);
LOCK_OR_FRAME(LOCAL_top_or_fr);
@ -1710,14 +1616,8 @@
SET_BB(PROTECT_FROZEN_B(B));
goto fail;
}
#ifdef TABLING_ERRORS
if (TR != B->cp_tr) {
if(! IsPairTerm((CELL)TrailTerm(TR - 1)))
TABLING_ERROR_MESSAGE("! IsPairTerm((CELL)TrailTerm(TR - 1)) (completion)");
if ((tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr)
TABLING_ERROR_MESSAGE("RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr (completion)");
}
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(completion, TR != B->cp_tr && !IsPairTerm((CELL)TrailTerm(TR - 1)));
TABLING_ERROR_CHECKING(completion, TR != B->cp_tr && (tr_fr_ptr) RepPair((CELL)TrailTerm(TR - 1)) != B->cp_tr);
pop_generator_node(SgFr_arity(sg_fr));
if (ans_node == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */

306
OPTYap/tab.macros.h
View File

@ -18,21 +18,19 @@
#include <stdlib.h>
#if HAVE_STRING_H
#include <string.h>
#endif
#endif /* HAVE_STRING_H */
#include "opt.mavar.h"
static inline CELL *expand_auxiliary_stack(CELL *);
static inline choiceptr freeze_current_cp(void);
static inline void resume_frozen_cp(choiceptr);
static inline void abolish_all_frozen_cps(void);
static inline void adjust_freeze_registers(void);
static inline void mark_as_completed(sg_fr_ptr);
static inline void unbind_variables(tr_fr_ptr, tr_fr_ptr);
static inline void rebind_variables(tr_fr_ptr, tr_fr_ptr);
static inline void restore_bindings(tr_fr_ptr, tr_fr_ptr);
static inline CELL *expand_auxiliary_stack(CELL *);
static inline void abolish_incomplete_subgoals(choiceptr);
static inline void free_subgoal_trie_hash_chain(sg_hash_ptr);
static inline void free_answer_trie_hash_chain(ans_hash_ptr);
static inline choiceptr freeze_current_cp(void);
static inline void resume_frozen_cp(choiceptr);
static inline void abolish_all_frozen_cps(void);
#ifdef YAPOR
static inline void pruning_over_tabling_data_structures(void);
static inline void collect_suspension_frames(or_fr_ptr);
@ -85,9 +83,9 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
/*********************
** Macros **
*********************/
/******************************
** Tabling defines **
******************************/
#define SHOW_MODE_STRUCTURE 0
#define SHOW_MODE_STATISTICS 1
@ -166,6 +164,12 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
#define EXPAND_AUX_STACK(STACK) STACK = expand_auxiliary_stack(STACK)
#endif /* YAPOR */
/*************************************
** Data structures macros **
*************************************/
#ifdef YAPOR
#define frame_with_suspensions_not_collected(OR_FR) \
(OrFr_nearest_suspnode(OR_FR) == NULL)
@ -413,24 +417,36 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
** Inline funcions **
******************************/
static inline
CELL *expand_auxiliary_stack(CELL *stack) {
void *old_top = Yap_TrailTop;
INFORMATION_MESSAGE("Expanding trail in 64 Kbytes");
if (! Yap_growtrail(64 * 1024L, TRUE)) { /* TRUE means 'contiguous_only' */
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)");
return NULL;
} else {
UInt diff = (void *)Yap_TrailTop - old_top;
CELL *new_stack = (CELL *)((void *)stack + diff);
memmove((void *)new_stack, (void *)stack, old_top - (void *)stack);
return new_stack;
}
static inline choiceptr freeze_current_cp(void) {
choiceptr freeze_cp = B;
B_FZ = freeze_cp;
H_FZ = freeze_cp->cp_h;
TR_FZ = freeze_cp->cp_tr;
B = B->cp_b;
HB = B->cp_h;
return freeze_cp;
}
static inline
void adjust_freeze_registers(void) {
static inline void resume_frozen_cp(choiceptr frozen_cp) {
restore_bindings(TR, frozen_cp->cp_tr);
B = frozen_cp;
TR = TR_FZ;
TRAIL_LINK(B->cp_tr);
return;
}
static inline void abolish_all_frozen_cps(void) {
B_FZ = (choiceptr) Yap_LocalBase;
H_FZ = (CELL *) Yap_GlobalBase;
TR_FZ = (tr_fr_ptr) Yap_TrailBase;
return;
}
static inline void adjust_freeze_registers(void) {
B_FZ = DepFr_cons_cp(LOCAL_top_dep_fr);
H_FZ = B_FZ->cp_h;
TR_FZ = B_FZ->cp_tr;
@ -438,8 +454,7 @@ void adjust_freeze_registers(void) {
}
static inline
void mark_as_completed(sg_fr_ptr sg_fr) {
static inline void mark_as_completed(sg_fr_ptr sg_fr) {
LOCK(SgFr_lock(sg_fr));
SgFr_state(sg_fr) = complete;
UNLOCK(SgFr_lock(sg_fr));
@ -447,12 +462,8 @@ void mark_as_completed(sg_fr_ptr sg_fr) {
}
static inline
void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
#ifdef TABLING_ERRORS
if (unbind_tr < end_tr)
TABLING_ERROR_MESSAGE("unbind_tr < end_tr (function unbind_variables)");
#endif /* TABLING_ERRORS */
static inline void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
TABLING_ERROR_CHECKING(unbind_variables, unbind_tr < end_tr);
/* unbind loop */
while (unbind_tr != end_tr) {
CELL ref = (CELL) TrailTerm(--unbind_tr);
@ -465,12 +476,8 @@ void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) {
/* avoid frozen segments */
unbind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (unbind_tr > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("unbind_tr > Yap_TrailTop (function unbind_variables)");
if (unbind_tr < end_tr)
TABLING_ERROR_MESSAGE("unbind_tr < end_tr (function unbind_variables)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(unbind_variables, unbind_tr > (tr_fr_ptr) Yap_TrailTop);
TABLING_ERROR_CHECKING(unbind_variables, unbind_tr < end_tr);
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
@ -485,12 +492,8 @@ void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
}
static inline
void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
#ifdef TABLING_ERRORS
if (rebind_tr < end_tr)
TABLING_ERROR_MESSAGE("rebind_tr < end_tr (function rebind_variables)");
#endif /* TABLING_ERRORS */
static inline void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
TABLING_ERROR_CHECKING(rebind_variables, rebind_tr < end_tr);
/* rebind loop */
Yap_NEW_MAHASH((ma_h_inner_struct *)H);
while (rebind_tr != end_tr) {
@ -504,12 +507,8 @@ void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) {
/* avoid frozen segments */
rebind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (rebind_tr > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("rebind_tr > Yap_TrailTop (function rebind_variables)");
if (rebind_tr < end_tr)
TABLING_ERROR_MESSAGE("rebind_tr < end_tr (function rebind_variables)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(rebind_variables, rebind_tr > (tr_fr_ptr) Yap_TrailTop);
TABLING_ERROR_CHECKING(rebind_variables, rebind_tr < end_tr);
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
@ -526,15 +525,11 @@ void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
}
static inline
void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
CELL ref;
tr_fr_ptr end_tr;
#ifdef TABLING_ERRORS
if (unbind_tr < rebind_tr)
TABLING_ERROR_MESSAGE("unbind_tr < rebind_tr (function restore_bindings)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(restore_variables, unbind_tr < rebind_tr);
end_tr = rebind_tr;
Yap_NEW_MAHASH((ma_h_inner_struct *)H);
while (unbind_tr != end_tr) {
@ -548,10 +543,7 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) {
/* avoid frozen segments */
unbind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (unbind_tr > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("unbind_tr > Yap_TrailTop (function restore_bindings)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(restore_variables, unbind_tr > (tr_fr_ptr) Yap_TrailTop);
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else if (IsApplTerm(ref)) {
@ -564,7 +556,7 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
if (!Yap_lookup_ma_var(pt)) {
pt[0] = TrailVal(unbind_tr);
}
#endif
#endif /* MULTI_ASSIGNMENT_VARIABLES */
}
}
/* look for end */
@ -575,10 +567,7 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) {
/* avoid frozen segments */
end_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (end_tr > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("end_tr > Yap_TrailTop (function restore_bindings)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(restore_variables, end_tr > (tr_fr_ptr) Yap_TrailTop);
}
}
}
@ -593,12 +582,8 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) {
/* avoid frozen segments */
rebind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (rebind_tr > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("rebind_tr > Yap_TrailTop (function restore_bindings)");
if (rebind_tr < end_tr)
TABLING_ERROR_MESSAGE("rebind_tr < end_tr (function restore_bindings)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(restore_variables, rebind_tr > (tr_fr_ptr) Yap_TrailTop);
TABLING_ERROR_CHECKING(restore_variables, rebind_tr < end_tr);
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
@ -613,8 +598,22 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
}
static inline
void abolish_incomplete_subgoals(choiceptr prune_cp) {
static inline CELL *expand_auxiliary_stack(CELL *stack) {
void *old_top = Yap_TrailTop;
INFORMATION_MESSAGE("Expanding trail in 64 Kbytes");
if (! Yap_growtrail(64 * 1024L, TRUE)) { /* TRUE means 'contiguous_only' */
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)");
return NULL;
} else {
UInt diff = (void *)Yap_TrailTop - old_top;
CELL *new_stack = (CELL *)((void *)stack + diff);
memmove((void *)new_stack, (void *)stack, old_top - (void *)stack);
return new_stack;
}
}
static inline void abolish_incomplete_subgoals(choiceptr prune_cp) {
#ifdef YAPOR
if (EQUAL_OR_YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), prune_cp))
pruning_over_tabling_data_structures();
@ -680,143 +679,19 @@ void abolish_incomplete_subgoals(choiceptr prune_cp) {
}
static inline
void free_subgoal_trie_hash_chain(sg_hash_ptr hash) {
while (hash) {
sg_node_ptr chain_node, *bucket, *last_bucket;
sg_hash_ptr next_hash;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(TrNode_parent(chain_node)) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_SUBGOAL_TRIE_HASH(hash);
hash = next_hash;
}
return;
}
static inline
void free_answer_trie_hash_chain(ans_hash_ptr hash) {
while (hash) {
ans_node_ptr chain_node, *bucket, *last_bucket;
ans_hash_ptr next_hash;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(UNTAG_ANSWER_LEAF_NODE(TrNode_parent(chain_node))) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_ANSWER_TRIE_HASH(hash);
hash = next_hash;
}
return;
}
/*
static inline
choiceptr create_cp_and_freeze(void) {
choiceptr freeze_cp;
// initialize and store freeze choice point
// freeze_cp = (NORM_CP(YENV) - 1);
freeze_cp = (NORM_CP(YENV) - 2);
HBREG = H;
store_yaam_reg_cpdepth(freeze_cp);
freeze_cp->cp_tr = TR;
freeze_cp->cp_ap = (yamop *)(TRUSTFAILCODE);
freeze_cp->cp_h = H;
freeze_cp->cp_b = B;
freeze_cp->cp_env = ENV;
freeze_cp->cp_cp = CPREG;
// set_cut((CELL *)freeze_cp, B);
B = freeze_cp;
SET_BB(B);
// adjust freeze registers
B_FZ = freeze_cp;
H_FZ = H;
TR_FZ = TR;
return freeze_cp;
}
*/
static inline
choiceptr freeze_current_cp(void) {
choiceptr freeze_cp = B;
B_FZ = freeze_cp;
H_FZ = freeze_cp->cp_h;
TR_FZ = freeze_cp->cp_tr;
B = B->cp_b;
HB = B->cp_h;
return freeze_cp;
}
static inline
void resume_frozen_cp(choiceptr frozen_cp) {
restore_bindings(TR, frozen_cp->cp_tr);
B = frozen_cp;
TR = TR_FZ;
TRAIL_LINK(B->cp_tr);
return;
}
static inline
void abolish_all_frozen_cps(void) {
B_FZ = (choiceptr) Yap_LocalBase;
H_FZ = (CELL *) Yap_GlobalBase;
TR_FZ = (tr_fr_ptr) Yap_TrailBase;
return;
}
#ifdef YAPOR
static inline
void pruning_over_tabling_data_structures(void) {
static inline void pruning_over_tabling_data_structures(void) {
Yap_Error(INTERNAL_ERROR, TermNil, "pruning over tabling data structures");
return;
}
static inline
void collect_suspension_frames(or_fr_ptr or_fr) {
static inline void collect_suspension_frames(or_fr_ptr or_fr) {
int depth;
or_fr_ptr *susp_ptr;
#ifdef OPTYAP_ERRORS
if (IS_UNLOCKED(or_fr))
OPTYAP_ERROR_MESSAGE("or_fr unlocked (collect_suspension_frames)");
if (OrFr_suspensions(or_fr) == NULL)
OPTYAP_ERROR_MESSAGE("OrFr_suspensions(or_fr) == NULL (collect_suspension_frames)");
#endif /* OPTYAP_ERRORS */
OPTYAP_ERROR_CHECKING(collect_suspension_frames, IS_UNLOCKED(or_fr));
OPTYAP_ERROR_CHECKING(collect_suspension_frames, OrFr_suspensions(or_fr) == NULL);
/* order collected suspension frames by depth */
depth = OrFr_depth(or_fr);
@ -869,8 +744,7 @@ susp_fr_ptr suspension_frame_to_resume(or_fr_ptr susp_or_fr) {
#ifdef TABLING_INNER_CUTS
static inline
void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr gen_cp, int ltt) {
static inline void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr gen_cp, int ltt) {
tg_sol_fr_ptr tg_sol_fr, *solution_ptr, next, ltt_next;
tg_ans_fr_ptr tg_ans_fr;
@ -923,8 +797,7 @@ void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr ge
}
static inline
tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr or_frame, tg_sol_fr_ptr new_solution, int ltt) {
static inline tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr or_frame, tg_sol_fr_ptr new_solution, int ltt) {
tg_sol_fr_ptr *old_solution_ptr, next_new_solution;
choiceptr node, gen_cp;
@ -972,8 +845,7 @@ tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr or_frame, tg_sol_fr_ptr new_solutio
}
static inline
void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
static inline void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
tg_ans_fr_ptr valid_answers, free_answer;
tg_sol_fr_ptr ltt_valid_solutions, free_solution;
ans_node_ptr first_answer, last_answer, ans_node;
@ -1042,8 +914,7 @@ void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
}
static inline
void CUT_join_tg_solutions(tg_sol_fr_ptr *old_solution_ptr, tg_sol_fr_ptr new_solution) {
static inline void CUT_join_tg_solutions(tg_sol_fr_ptr *old_solution_ptr, tg_sol_fr_ptr new_solution) {
tg_sol_fr_ptr next_old_solution, next_new_solution;
choiceptr gen_cp;
@ -1090,8 +961,7 @@ void CUT_join_tg_solutions(tg_sol_fr_ptr *old_solution_ptr, tg_sol_fr_ptr new_so
}
static inline
void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr join_solution) {
static inline void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr join_solution) {
tg_sol_fr_ptr next_solution;
while ((next_solution = TgSolFr_ltt_next(join_solution))) {
@ -1104,8 +974,7 @@ void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr join_solution) {
}
static inline
void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr join_solution) {
static inline void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr join_solution) {
do {
CUT_join_solution_frame_tg_answers(join_solution);
join_solution = TgSolFr_next(join_solution);
@ -1114,8 +983,7 @@ void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr join_solution) {
}
static inline
void CUT_free_tg_solution_frame(tg_sol_fr_ptr solution) {
static inline void CUT_free_tg_solution_frame(tg_sol_fr_ptr solution) {
tg_ans_fr_ptr current_answer, next_answer;
current_answer = TgSolFr_first(solution);
@ -1129,8 +997,7 @@ void CUT_free_tg_solution_frame(tg_sol_fr_ptr solution) {
}
static inline
void CUT_free_tg_solution_frames(tg_sol_fr_ptr current_solution) {
static inline void CUT_free_tg_solution_frames(tg_sol_fr_ptr current_solution) {
tg_sol_fr_ptr ltt_solution, next_solution;
while (current_solution) {
@ -1148,8 +1015,7 @@ void CUT_free_tg_solution_frames(tg_sol_fr_ptr current_solution) {
}
static inline
tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr solutions, int ltt) {
static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr solutions, int ltt) {
tg_sol_fr_ptr ltt_next_solution, return_solution;
if (! solutions) return NULL;

19
OPTYap/tab.structs.h
View File

@ -55,17 +55,20 @@ typedef struct global_trie_node {
struct global_trie_node *parent;
struct global_trie_node *child;
struct global_trie_node *next;
#ifdef TABLE_LOCK_AT_NODE_LEVEL
lockvar lock;
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
} *gt_node_ptr;
#endif /* GLOBAL_TRIE */
typedef struct subgoal_trie_node {
Term entry;
#ifdef TABLE_LOCK_AT_NODE_LEVEL
lockvar lock;
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
struct subgoal_trie_node *parent;
struct subgoal_trie_node *child;
struct subgoal_trie_node *next;
#ifdef TABLE_LOCK_AT_NODE_LEVEL
lockvar lock;
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
} *sg_node_ptr;
typedef struct answer_trie_node {
@ -74,22 +77,22 @@ typedef struct answer_trie_node {
int or_arg; /* u.Otapl.or_arg */
#endif /* YAPOR */
Term entry;
#ifdef TABLE_LOCK_AT_NODE_LEVEL
lockvar lock;
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
struct answer_trie_node *parent;
struct answer_trie_node *child;
struct answer_trie_node *next;
#ifdef TABLE_LOCK_AT_NODE_LEVEL
lockvar lock;
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
} *ans_node_ptr;
#define TrNode_instr(X) ((X)->trie_instruction)
#define TrNode_or_arg(X) ((X)->or_arg)
#define TrNode_entry(X) ((X)->entry)
#define TrNode_lock(X) ((X)->lock)
#define TrNode_parent(X) ((X)->parent)
#define TrNode_child(X) ((X)->child)
#define TrNode_sg_fr(X) ((X)->child)
#define TrNode_next(X) ((X)->next)
#define TrNode_lock(X) ((X)->lock)
@ -190,7 +193,7 @@ struct loader_choicept {
typedef struct subgoal_frame {
#if defined(YAPOR) || defined(THREADS)
lockvar lock;
#endif
#endif /* YAPOR || THREADS */
#ifdef YAPOR
int generator_worker;
struct or_frame *top_or_frame_on_generator_branch;

827
OPTYap/tab.tries.c
View File

@ -448,276 +448,89 @@ static void free_global_trie_branch(gt_node_ptr current_node, int mode) {
}
return;
}
static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
int *current_arity = NULL, current_str_index = 0, current_mode = 0;
/* test if hashing */
if (IS_GLOBAL_TRIE_HASH(current_node)) {
gt_node_ptr *bucket, *last_bucket;
gt_hash_ptr hash;
hash = (gt_hash_ptr) current_node;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_global_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
}
} while (++bucket != last_bucket);
free(current_arity);
return;
}
/* save current state if first sibling node */
if (position == TRAVERSE_POSITION_FIRST) {
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
current_str_index = str_index;
current_mode = mode;
}
/* process current trie node */
TrStat_gt_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL);
/* continue with child node ... */
if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
traverse_global_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
/* ... or show term */
else {
TrStat_gt_terms++;
str[str_index] = 0;
SHOW_TABLE_STRUCTURE(" TERMx%ld: %s\n", (unsigned long int) TrNode_child(current_node), str);
}
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
str_index = current_str_index;
mode = current_mode;
current_node = TrNode_next(current_node);
while (current_node) {
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_global_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
current_node = TrNode_next(current_node);
}
free(current_arity);
}
return;
}
static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode, int type) {
if (TrNode_parent(current_node) != GLOBAL_root_gt)
traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, arity, mode, type);
traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, type);
return;
}
#endif /* GLOBAL_TRIE */
static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
int *current_arity = NULL, current_str_index = 0, current_mode = 0;
/* test if hashing */
if (IS_SUBGOAL_TRIE_HASH(current_node)) {
sg_node_ptr *bucket, *last_bucket;
sg_hash_ptr hash;
hash = (sg_hash_ptr) current_node;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_subgoal_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
}
} while (++bucket != last_bucket);
free(current_arity);
return;
}
/* save current state if first sibling node */
if (position == TRAVERSE_POSITION_FIRST) {
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
current_str_index = str_index;
current_mode = mode;
}
/* process current trie node */
TrStat_sg_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL);
/* continue with child node ... */
if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
/* ... or show answers */
else {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrNode_sg_fr(current_node);
TrStat_subgoals++;
str[str_index] = 0;
SHOW_TABLE_STRUCTURE("%s.\n", str);
TrStat_ans_nodes++;
if (SgFr_first_answer(sg_fr) == NULL) {
if (SgFr_state(sg_fr) < complete) {
TrStat_sg_incomplete++;
SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
} else {
TrStat_answers_no++;
SHOW_TABLE_STRUCTURE(" NO\n");
}
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
TrStat_answers_true++;
SHOW_TABLE_STRUCTURE(" TRUE\n");
} else {
arity[0] = 0;
traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
if (SgFr_state(sg_fr) < complete) {
TrStat_sg_incomplete++;
SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
}
}
}
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
str_index = current_str_index;
mode = current_mode;
current_node = TrNode_next(current_node);
while (current_node) {
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_subgoal_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
current_node = TrNode_next(current_node);
}
free(current_arity);
}
return;
}
static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_index, int *arity, int var_index, int mode, int position) {
int *current_arity = NULL, current_str_index = 0, current_var_index = 0, current_mode = 0;
/* test if hashing */
if (IS_ANSWER_TRIE_HASH(current_node)) {
ans_node_ptr *bucket, *last_bucket;
ans_hash_ptr hash;
hash = (ans_hash_ptr) current_node;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
}
} while (++bucket != last_bucket);
free(current_arity);
return;
}
/* save current state if first sibling node */
if (position == TRAVERSE_POSITION_FIRST) {
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
current_str_index = str_index;
current_var_index = var_index;
current_mode = mode;
}
/* print VAR if starting a term */
if (arity[0] == 0 && mode == TRAVERSE_MODE_NORMAL) {
str_index += sprintf(& str[str_index], " VAR%d: ", var_index);
var_index++;
}
/* process current trie node */
TrStat_ans_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER);
/* show answer .... */
if (IS_ANSWER_LEAF_NODE(current_node)) {
TrStat_answers++;
str[str_index] = 0;
SHOW_TABLE_STRUCTURE("%s\n", str);
}
#ifdef YAPOR
#ifdef TABLING_INNER_CUTS
/* ... or continue with pruned node */
else if (TrNode_child(current_node) == NULL) {
TrStat_answers++;
TrStat_answers_pruned++;
}
#endif /* TABLING_INNER_CUTS */
/* ... or continue with child node */
else
traverse_answer_trie(TrNode_child(current_node), str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
str_index = current_str_index;
var_index = current_var_index;
mode = current_mode;
current_node = TrNode_next(current_node);
while (current_node) {
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_answer_trie(current_node, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_NEXT);
current_node = TrNode_next(current_node);
static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr current_node) {
int ltt;
if (! IS_ANSWER_LEAF_NODE(current_node)) {
if (TrNode_child(current_node)) {
TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
update_answer_trie_branch(NULL, TrNode_child(current_node));
if (TrNode_child(current_node))
goto update_next_trie_branch;
}
free(current_arity);
/* node belonging to a pruned answer */
if (previous_node) {
TrNode_next(previous_node) = TrNode_next(current_node);
FREE_ANSWER_TRIE_NODE(current_node);
if (TrNode_next(previous_node)) {
return update_answer_trie_branch(previous_node, TrNode_next(previous_node));
} else {
TrNode_instr(previous_node) -= 2; /* retry --> trust : try --> do */
return 0;
}
} else {
TrNode_child(TrNode_parent(current_node)) = TrNode_next(current_node);
if (TrNode_next(current_node)) {
TrNode_instr(TrNode_next(current_node)) -= 1; /* retry --> try */
update_answer_trie_branch(NULL, TrNode_next(current_node));
}
FREE_ANSWER_TRIE_NODE(current_node);
return 0;
}
}
update_next_trie_branch:
if (TrNode_next(current_node)) {
ltt = 1 + update_answer_trie_branch(current_node, TrNode_next(current_node));
} else {
TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
ltt = 1;
}
TrNode_or_arg(current_node) = ltt;
TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
return ltt;
}
#else /* YAPOR && ! TABLING_INNER_CUTS */
static int update_answer_trie_branch(ans_node_ptr current_node) {
int ltt;
if (! IS_ANSWER_LEAF_NODE(current_node)) {
TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
update_answer_trie_branch(TrNode_child(current_node));
}
if (TrNode_next(current_node)) {
ltt = 1 + update_answer_trie_branch(TrNode_next(current_node));
} else {
TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
ltt = 1;
}
TrNode_or_arg(current_node) = ltt;
TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
return ltt;
}
#endif
#else /* ! YAPOR */
static void update_answer_trie_branch(ans_node_ptr current_node, int position) {
if (! IS_ANSWER_LEAF_NODE(current_node))
update_answer_trie_branch(TrNode_child(current_node), TRAVERSE_POSITION_FIRST); /* retry --> try */
if (position == TRAVERSE_POSITION_FIRST) {
ans_node_ptr next = TrNode_next(current_node);
if (next) {
while (TrNode_next(next)) {
update_answer_trie_branch(next, TRAVERSE_POSITION_NEXT); /* retry --> retry */
next = TrNode_next(next);
}
update_answer_trie_branch(next, TRAVERSE_POSITION_LAST); /* retry --> trust */
} else
position += TRAVERSE_POSITION_LAST; /* try --> do */
}
TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node) - position);
return;
}
#endif /* YAPOR */
static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type) {
@ -953,86 +766,275 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int
}
#ifdef YAPOR
#ifdef TABLING_INNER_CUTS
static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr current_node) {
int ltt;
if (! IS_ANSWER_LEAF_NODE(current_node)) {
if (TrNode_child(current_node)) {
TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
update_answer_trie_branch(NULL, TrNode_child(current_node));
if (TrNode_child(current_node))
goto update_next_trie_branch;
}
/* node belonging to a pruned answer */
if (previous_node) {
TrNode_next(previous_node) = TrNode_next(current_node);
FREE_ANSWER_TRIE_NODE(current_node);
if (TrNode_next(previous_node)) {
return update_answer_trie_branch(previous_node, TrNode_next(previous_node));
} else {
TrNode_instr(previous_node) -= 2; /* retry --> trust : try --> do */
return 0;
}
} else {
TrNode_child(TrNode_parent(current_node)) = TrNode_next(current_node);
if (TrNode_next(current_node)) {
TrNode_instr(TrNode_next(current_node)) -= 1; /* retry --> try */
update_answer_trie_branch(NULL, TrNode_next(current_node));
}
FREE_ANSWER_TRIE_NODE(current_node);
return 0;
}
}
update_next_trie_branch:
if (TrNode_next(current_node)) {
ltt = 1 + update_answer_trie_branch(current_node, TrNode_next(current_node));
} else {
TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
ltt = 1;
}
TrNode_or_arg(current_node) = ltt;
TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
return ltt;
}
#else /* YAPOR && ! TABLING_INNER_CUTS */
static int update_answer_trie_branch(ans_node_ptr current_node) {
int ltt;
if (! IS_ANSWER_LEAF_NODE(current_node)) {
TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
update_answer_trie_branch(TrNode_child(current_node));
}
if (TrNode_next(current_node)) {
ltt = 1 + update_answer_trie_branch(TrNode_next(current_node));
} else {
TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
ltt = 1;
}
TrNode_or_arg(current_node) = ltt;
TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
return ltt;
}
#endif
#else /* ! YAPOR */
static void update_answer_trie_branch(ans_node_ptr current_node, int position) {
if (! IS_ANSWER_LEAF_NODE(current_node))
update_answer_trie_branch(TrNode_child(current_node), TRAVERSE_POSITION_FIRST); /* retry --> try */
if (position == TRAVERSE_POSITION_FIRST) {
ans_node_ptr next = TrNode_next(current_node);
if (next) {
while (TrNode_next(next)) {
update_answer_trie_branch(next, TRAVERSE_POSITION_NEXT); /* retry --> retry */
next = TrNode_next(next);
}
update_answer_trie_branch(next, TRAVERSE_POSITION_LAST); /* retry --> trust */
} else
position += TRAVERSE_POSITION_LAST; /* try --> do */
}
TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node) - position);
#ifdef GLOBAL_TRIE
static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode, int type) {
if (TrNode_parent(current_node) != GLOBAL_root_gt)
traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, arity, mode, type);
traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, type);
return;
}
static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
int *current_arity = NULL, current_str_index = 0, current_mode = 0;
/* test if hashing */
if (IS_GLOBAL_TRIE_HASH(current_node)) {
gt_node_ptr *bucket, *last_bucket;
gt_hash_ptr hash;
hash = (gt_hash_ptr) current_node;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_global_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
}
} while (++bucket != last_bucket);
free(current_arity);
return;
}
/* save current state if first sibling node */
if (position == TRAVERSE_POSITION_FIRST) {
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
current_str_index = str_index;
current_mode = mode;
}
/* process current trie node */
TrStat_gt_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL);
/* continue with child node ... */
if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
traverse_global_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
/* ... or show term */
else {
TrStat_gt_terms++;
str[str_index] = 0;
SHOW_TABLE_STRUCTURE(" TERMx%ld: %s\n", (unsigned long int) TrNode_child(current_node), str);
}
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
str_index = current_str_index;
mode = current_mode;
current_node = TrNode_next(current_node);
while (current_node) {
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_global_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
current_node = TrNode_next(current_node);
}
free(current_arity);
}
return;
}
#endif /* GLOBAL_TRIE */
static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_index, int *arity, int var_index, int mode, int position) {
int *current_arity = NULL, current_str_index = 0, current_var_index = 0, current_mode = 0;
/* test if hashing */
if (IS_ANSWER_TRIE_HASH(current_node)) {
ans_node_ptr *bucket, *last_bucket;
ans_hash_ptr hash;
hash = (ans_hash_ptr) current_node;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
}
} while (++bucket != last_bucket);
free(current_arity);
return;
}
/* save current state if first sibling node */
if (position == TRAVERSE_POSITION_FIRST) {
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
current_str_index = str_index;
current_var_index = var_index;
current_mode = mode;
}
/* print VAR if starting a term */
if (arity[0] == 0 && mode == TRAVERSE_MODE_NORMAL) {
str_index += sprintf(& str[str_index], " VAR%d: ", var_index);
var_index++;
}
/* process current trie node */
TrStat_ans_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER);
/* show answer .... */
if (IS_ANSWER_LEAF_NODE(current_node)) {
TrStat_answers++;
str[str_index] = 0;
SHOW_TABLE_STRUCTURE("%s\n", str);
}
#ifdef TABLING_INNER_CUTS
/* ... or continue with pruned node */
else if (TrNode_child(current_node) == NULL) {
TrStat_answers++;
TrStat_answers_pruned++;
}
#endif /* TABLING_INNER_CUTS */
/* ... or continue with child node */
else
traverse_answer_trie(TrNode_child(current_node), str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
str_index = current_str_index;
var_index = current_var_index;
mode = current_mode;
current_node = TrNode_next(current_node);
while (current_node) {
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_answer_trie(current_node, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_NEXT);
current_node = TrNode_next(current_node);
}
free(current_arity);
}
return;
}
static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
int *current_arity = NULL, current_str_index = 0, current_mode = 0;
/* test if hashing */
if (IS_SUBGOAL_TRIE_HASH(current_node)) {
sg_node_ptr *bucket, *last_bucket;
sg_hash_ptr hash;
hash = (sg_hash_ptr) current_node;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_subgoal_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
}
} while (++bucket != last_bucket);
free(current_arity);
return;
}
/* save current state if first sibling node */
if (position == TRAVERSE_POSITION_FIRST) {
current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
current_str_index = str_index;
current_mode = mode;
}
/* process current trie node */
TrStat_sg_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL);
/* continue with child node ... */
if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
/* ... or show answers */
else {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrNode_sg_fr(current_node);
TrStat_subgoals++;
str[str_index] = 0;
SHOW_TABLE_STRUCTURE("%s.\n", str);
TrStat_ans_nodes++;
if (SgFr_first_answer(sg_fr) == NULL) {
if (SgFr_state(sg_fr) < complete) {
TrStat_sg_incomplete++;
SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
} else {
TrStat_answers_no++;
SHOW_TABLE_STRUCTURE(" NO\n");
}
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
TrStat_answers_true++;
SHOW_TABLE_STRUCTURE(" TRUE\n");
} else {
arity[0] = 0;
traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
if (SgFr_state(sg_fr) < complete) {
TrStat_sg_incomplete++;
SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
}
}
}
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
str_index = current_str_index;
mode = current_mode;
current_node = TrNode_next(current_node);
while (current_node) {
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#else
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_subgoal_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
current_node = TrNode_next(current_node);
}
free(current_arity);
}
return;
}
#endif /* YAPOR */
@ -1106,10 +1108,7 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
current_ans_node = SgFr_answer_trie(sg_fr);
for (i = subs_arity; i >= 1; i--) {
#ifdef TABLING_ERRORS
if (IsNonVarTerm(subs_ptr[i]))
TABLING_ERROR_MESSAGE("IsNonVarTem(subs_ptr[i]) (answer_search)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(answer search, IsNonVarTerm(subs_ptr[i]));
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
}
@ -1130,10 +1129,7 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) {
CELL *stack_terms;
int i;
#ifdef TABLING_ERRORS
if (H < H_FZ)
TABLING_ERROR_MESSAGE("H < H_FZ (load_answer)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(load_answer, H < H_FZ);
if (subs_arity == 0)
return;
@ -1143,10 +1139,7 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) {
Term t = STACK_POP_DOWN(stack_terms);
Bind((CELL *) subs_ptr[i], t);
}
#ifdef TABLING_ERRORS
if (stack_terms != (CELL *)Yap_TrailTop)
TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_answer)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(load_answer, stack_terms != (CELL *)Yap_TrailTop);
return;
#undef subs_arity
@ -1166,10 +1159,7 @@ CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) {
subs_ptr = aux_stack + aux_stack[1] + 2;
t = STACK_POP_DOWN(stack_terms);
Bind((CELL *) subs_ptr[subs_arity], t);
#ifdef TABLING_ERRORS
if (stack_terms != (CELL *)Yap_TrailTop)
TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (exec_substitution)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(exec_substitution, stack_terms != (CELL *)Yap_TrailTop);
*subs_ptr = subs_arity - 1;
return aux_stack;
@ -1178,6 +1168,29 @@ CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) {
#endif /* GLOBAL_TRIE */
void update_answer_trie(sg_fr_ptr sg_fr) {
ans_node_ptr current_node;
free_answer_trie_hash_chain(SgFr_hash_chain(sg_fr));
SgFr_hash_chain(sg_fr) = NULL;
SgFr_state(sg_fr) += 2; /* complete --> compiled : complete_in_use --> compiled_in_use */
current_node = TrNode_child(SgFr_answer_trie(sg_fr));
if (current_node) {
#ifdef YAPOR
TrNode_instr(current_node) -= 1;
#ifdef TABLING_INNER_CUTS
update_answer_trie_branch(NULL, current_node);
#else
update_answer_trie_branch(current_node);
#endif /* TABLING_INNER_CUTS */
#else /* TABLING */
update_answer_trie_branch(current_node, TRAVERSE_POSITION_FIRST);
#endif /* YAPOR */
}
return;
}
#ifdef GLOBAL_TRIE
void free_subgoal_trie_branch(sg_node_ptr current_node, int nodes_left, int position) {
if (nodes_left) {
@ -1300,24 +1313,57 @@ void free_answer_trie_branch(ans_node_ptr current_node, int position) {
}
void update_answer_trie(sg_fr_ptr sg_fr) {
ans_node_ptr current_node;
void free_subgoal_trie_hash_chain(sg_hash_ptr hash) {
while (hash) {
sg_node_ptr chain_node, *bucket, *last_bucket;
sg_hash_ptr next_hash;
free_answer_trie_hash_chain(SgFr_hash_chain(sg_fr));
SgFr_hash_chain(sg_fr) = NULL;
SgFr_state(sg_fr) += 2; /* complete --> compiled : complete_in_use --> compiled_in_use */
current_node = TrNode_child(SgFr_answer_trie(sg_fr));
if (current_node) {
#ifdef YAPOR
TrNode_instr(current_node) -= 1;
#ifdef TABLING_INNER_CUTS
update_answer_trie_branch(NULL, current_node);
#else
update_answer_trie_branch(current_node);
#endif /* TABLING_INNER_CUTS */
#else /* TABLING */
update_answer_trie_branch(current_node, TRAVERSE_POSITION_FIRST);
#endif /* YAPOR */
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(TrNode_parent(chain_node)) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_SUBGOAL_TRIE_HASH(hash);
hash = next_hash;
}
return;
}
void free_answer_trie_hash_chain(ans_hash_ptr hash) {
while (hash) {
ans_node_ptr chain_node, *bucket, *last_bucket;
ans_hash_ptr next_hash;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(UNTAG_ANSWER_LEAF_NODE(TrNode_parent(chain_node))) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_ANSWER_TRIE_HASH(hash);
hash = next_hash;
}
return;
}
@ -1425,41 +1471,4 @@ void show_global_trie(int show_mode) {
return;
}
#endif /* GLOBAL_TRIE */
void private_completion(sg_fr_ptr sg_fr) {
/* complete subgoals */
#ifdef LIMIT_TABLING
sg_fr_ptr aux_sg_fr;
while (LOCAL_top_sg_fr != sg_fr) {
aux_sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(aux_sg_fr);
mark_as_completed(aux_sg_fr);
insert_into_global_sg_fr_list(aux_sg_fr);
}
aux_sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(aux_sg_fr);
mark_as_completed(aux_sg_fr);
insert_into_global_sg_fr_list(aux_sg_fr);
#else
while (LOCAL_top_sg_fr != sg_fr) {
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
#endif /* LIMIT_TABLING */
/* release dependency frames */
while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) { /* never equal if batched scheduling */
dep_fr_ptr dep_fr = DepFr_next(LOCAL_top_dep_fr);
FREE_DEPENDENCY_FRAME(LOCAL_top_dep_fr);
LOCAL_top_dep_fr = dep_fr;
}
/* adjust freeze registers */
adjust_freeze_registers();
return;
}
#endif /* TABLING */

12
OPTYap/tab.tries.i
View File

@ -383,11 +383,7 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
#endif /* MODE_GLOBAL_TRIE_ENTRY */
ans_node_ptr child_node;
#ifdef TABLING_ERRORS
if (IS_ANSWER_LEAF_NODE(parent_node))
TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_trie_check_insert_(gt)_entry)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(answer_trie_check_insert_(gt)_entry, IS_ANSWER_LEAF_NODE(parent_node));
LOCK_NODE(parent_node);
child_node = TrNode_child(parent_node);
if (child_node == NULL) {
@ -485,11 +481,7 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
ans_node_ptr child_node;
ans_hash_ptr hash;
#ifdef TABLING_ERRORS
if (IS_ANSWER_LEAF_NODE(parent_node))
TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_trie_check_insert_(gt)_entry)");
#endif /* TABLING_ERRORS */
TABLING_ERROR_CHECKING(answer_trie_check_insert_(gt)_entry, IS_ANSWER_LEAF_NODE(parent_node));
child_node = TrNode_child(parent_node);
if (child_node == NULL) {
#ifdef ALLOC_BEFORE_CHECK

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

@ -99,7 +99,7 @@
B = cp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
TABLING_ERROR_CHECKING_STACK; \
} \
copy_aux_stack()

16
VC/include/Yap.h
View File

@ -320,16 +320,16 @@ typedef CELL Term;
#include <nolocks.h>
#else
#ifdef i386
#include <x86_locks.h>
#include <locks_x86.h>
#endif
#if defined(sparc) || defined(__sparc)
#include <sparc_locks.h>
#include <locks_sparc.h>
#endif
#ifdef mips
#include <mips_locks.h>
#include <locks_mips.h>
#endif
#ifdef __alpha
#include <alpha_locks.h>
#include <locks_alpha.h>
#endif
#endif
@ -367,10 +367,10 @@ typedef CELL Term;
#if defined(YAPOR) ||defined(THREADS)
#ifdef mips
#include <mips_locks_funcs.h>
#include <locks_mips_funcs.h>
#endif
#ifdef __alpha
#include <alpha_locks_funcs.h>
#include <locks_alpha_funcs.h>
#endif
#endif
@ -826,7 +826,7 @@ inline EXTERN Int IntegerOfTerm(Term t)
/*************** unification routines ***********************************/
#if SBA
#include "sbaamiops.h"
#include "or.sbaamiops.h"
#else
#include "amiops.h"
#endif
@ -1047,6 +1047,6 @@ extern int snoozing;
#endif /* YAPOR || TABLING */
#if SBA
#include "sbaunify.h"
#include "or.sbaunify.h"
#endif

22
VC/yapdll.mak
View File

@ -82,7 +82,6 @@ CLEAN :
-@erase "$(INTDIR)\modules.obj"
-@erase "$(INTDIR)\opt.init.obj"
-@erase "$(INTDIR)\opt.memory.obj"
-@erase "$(INTDIR)\opt.misc.obj"
-@erase "$(INTDIR)\opt.preds.obj"
-@erase "$(INTDIR)\or.cowengine.obj"
-@erase "$(INTDIR)\or.cut.obj"
@ -96,7 +95,7 @@ CLEAN :
-@erase "$(INTDIR)\sort.obj"
-@erase "$(INTDIR)\stdpreds.obj"
-@erase "$(INTDIR)\sysbits.obj"
-@erase "$(INTDIR)\tab.suspend.obj"
-@erase "$(INTDIR)\tab.completion.obj"
-@erase "$(INTDIR)\tab.tries.obj"
-@erase "$(INTDIR)\tracer.obj"
-@erase "$(INTDIR)\unify.obj"
@ -163,7 +162,6 @@ LINK32_OBJS= \
"$(INTDIR)\modules.obj" \
"$(INTDIR)\opt.init.obj" \
"$(INTDIR)\opt.memory.obj" \
"$(INTDIR)\opt.misc.obj" \
"$(INTDIR)\opt.preds.obj" \
"$(INTDIR)\or.cowengine.obj" \
"$(INTDIR)\or.cut.obj" \
@ -177,7 +175,7 @@ LINK32_OBJS= \
"$(INTDIR)\sort.obj" \
"$(INTDIR)\stdpreds.obj" \
"$(INTDIR)\sysbits.obj" \
"$(INTDIR)\tab.suspend.obj" \
"$(INTDIR)\tab.completion.obj" \
"$(INTDIR)\tab.tries.obj" \
"$(INTDIR)\tracer.obj" \
"$(INTDIR)\unify.obj" \
@ -245,7 +243,6 @@ CLEAN :
-@erase "$(INTDIR)\modules.obj"
-@erase "$(INTDIR)\opt.init.obj"
-@erase "$(INTDIR)\opt.memory.obj"
-@erase "$(INTDIR)\opt.misc.obj"
-@erase "$(INTDIR)\opt.preds.obj"
-@erase "$(INTDIR)\or.cowengine.obj"
-@erase "$(INTDIR)\or.cut.obj"
@ -259,7 +256,7 @@ CLEAN :
-@erase "$(INTDIR)\sort.obj"
-@erase "$(INTDIR)\stdpreds.obj"
-@erase "$(INTDIR)\sysbits.obj"
-@erase "$(INTDIR)\tab.suspend.obj"
-@erase "$(INTDIR)\tab.completion.obj"
-@erase "$(INTDIR)\tab.tries.obj"
-@erase "$(INTDIR)\tracer.obj"
-@erase "$(INTDIR)\unify.obj"
@ -329,7 +326,6 @@ LINK32_OBJS= \
"$(INTDIR)\modules.obj" \
"$(INTDIR)\opt.init.obj" \
"$(INTDIR)\opt.memory.obj" \
"$(INTDIR)\opt.misc.obj" \
"$(INTDIR)\opt.preds.obj" \
"$(INTDIR)\or.cowengine.obj" \
"$(INTDIR)\or.cut.obj" \
@ -343,7 +339,7 @@ LINK32_OBJS= \
"$(INTDIR)\sort.obj" \
"$(INTDIR)\stdpreds.obj" \
"$(INTDIR)\sysbits.obj" \
"$(INTDIR)\tab.suspend.obj" \
"$(INTDIR)\tab.completion.obj" \
"$(INTDIR)\tab.tries.obj" \
"$(INTDIR)\tracer.obj" \
"$(INTDIR)\unify.obj" \
@ -647,12 +643,6 @@ SOURCE="\Yap\Yap-4.3.17\OPTYap\opt.memory.c"
$(CPP) $(CPP_PROJ) $(SOURCE)
SOURCE="\Yap\Yap-4.3.17\OPTYap\opt.misc.c"
"$(INTDIR)\opt.misc.obj" : $(SOURCE) "$(INTDIR)"
$(CPP) $(CPP_PROJ) $(SOURCE)
SOURCE="\Yap\Yap-4.3.17\OPTYap\opt.preds.c"
"$(INTDIR)\opt.preds.obj" : $(SOURCE) "$(INTDIR)"
@ -731,9 +721,9 @@ SOURCE="\Yap\Yap-4.3.17\C\sysbits.c"
$(CPP) $(CPP_PROJ) $(SOURCE)
SOURCE="\Yap\Yap-4.3.17\OPTYap\tab.suspend.c"
SOURCE="\Yap\Yap-4.3.17\OPTYap\tab.completion.c"
"$(INTDIR)\tab.suspend.obj" : $(SOURCE) "$(INTDIR)"
"$(INTDIR)\tab.completion.obj" : $(SOURCE) "$(INTDIR)"
$(CPP) $(CPP_PROJ) $(SOURCE)

16
docs/yap.tex
View File

@ -9113,14 +9113,24 @@ For every line @var{LineIn} in stream @var{StreamInp}, execute
stream @var{StreamOut}.
@item file_filter(+@var{FileIn}, +@var{FileOut}, +@var{Goal})
@findex filter/3
@snindex filter/3
@cnindex filter/3
@findex file_filter/3
@snindex file_filter/3
@cnindex file_filter/3
For every line @var{LineIn} in file @var{FileIn}, execute
@code{call(Goal,LineIn,LineOut)}, and output @var{LineOut} to file
@var{FileOut}.
@item file_filter(+@var{FileIn}, +@var{FileOut}, +@var{Goal},
+@var{FormatCommand}, +@var{Arguments})
@findex file_filter_with_init/5
@snindex file_filter_with_init/5
@cnindex file_filter_with_init/5
Same as @code{file_filter/3}, but before starting the filter execute
@code{format/3} on the output stream, using @var{FormatCommand} and
@var{Arguments}.
@end table

11
library/lineutils.yap
View File

@ -11,10 +11,11 @@
copy_line/2,
filter/3,
file_filter/3,
file_filter_with_init/5,
process/2
]).
:- meta_predicate filter(+,+,:), file_filter(+,+,:), process(+,:).
:- meta_predicate filter(+,+,:), file_filter(+,+,:), file_filter_with_init(+,+,:,+,:), process(+,:).
:- use_module(library(lists),
[member/2,
@ -137,4 +138,12 @@ file_filter(Inp, Out, Command) :-
close(StreamInp),
close(StreamOut).
file_filter_with_init(Inp, Out, Command, FormatString, Parameters) :-
open(Inp, read, StreamInp),
open(Out, write, StreamOut),
format(StreamOut, FormatString, Parameters),
filter(StreamInp, StreamOut, Command),
close(StreamInp),
close(StreamOut).

12
misc/buildatoms
View File

@ -1,6 +1,6 @@
:- use_module(library(lineutils),
[file_filter/3,
[file_filter_with_init/5,
split/3]).
:- use_module(library(lists),
@ -11,11 +11,13 @@
:- yap_flag(write_strings,on).
main :-
file_filter('misc/ATOMS','H/tatoms.h',gen_fields),
file_filter('misc/ATOMS','H/iatoms.h',gen_decl),
file_filter('misc/ATOMS','H/ratoms.h',gen_rcov).
% file_filter('misc/ATOMS','packages/PLStream/natoms.h',gen_swiatoms).
warning(Warning),
file_filter_with_init('misc/ATOMS','H/tatoms.h',gen_fields, Warning, ['tatoms.h']),
file_filter_with_init('misc/ATOMS','H/iatoms.h',gen_decl, Warning, ['iatoms.h']),
file_filter_with_init('misc/ATOMS','H/ratoms.h',gen_rcov, Warning, ['ratoms.h']).
% file_filter_with_init('misc/ATOMS','packages/PLStream/natoms.h', gen_swiatoms, Warning, ['natoms.h']).
warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildatoms\"~n please do not update, update misc/ATOMS instead */~n~n').
gen_fields(Inp,Out) :-
split(Inp," ",["A",Atom,_,_]), !,

21
misc/buildheap
View File

@ -1,6 +1,6 @@
:- use_module(library(lineutils),
[file_filter/3,
[file_filter_with_init/5,
split/3,
glue/3]).
@ -17,15 +17,18 @@
:- style_check(all).
main :-
file_filter('misc/HEAPFIELDS','H/hstruct.h',gen_struct),
file_filter('misc/HEAPFIELDS','H/dhstruct.h',gen_dstruct),
file_filter('misc/HEAPFIELDS','H/rhstruct.h',gen_hstruct),
file_filter('misc/HEAPFIELDS','H/ihstruct.h',gen_init),
file_filter('misc/GLOBALS','H/hglobals.h',gen_struct),
file_filter('misc/GLOBALS','H/dglobals.h',gen_dstruct),
file_filter('misc/GLOBALS','H/rglobals.h',gen_hstruct),
file_filter('misc/GLOBALS','H/iglobals.h',gen_init).
warning(Warning),
file_filter_with_init('misc/HEAPFIELDS','H/hstruct.h',gen_struct,Warning,['hstruct.h','HEAPFIELDS']),
file_filter_with_init('misc/HEAPFIELDS','H/dhstruct.h',gen_dstruct,Warning,['dhstruct.h','HEAPFIELDS']),
file_filter_with_init('misc/HEAPFIELDS','H/rhstruct.h',gen_hstruct,Warning,['rhstruct.h','HEAPFIELDS']),
file_filter_with_init('misc/HEAPFIELDS','H/ihstruct.h',gen_init,Warning,['ihstruct.h','HEAPFIELDS']),
file_filter_with_init('misc/GLOBALS','H/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']),
file_filter_with_init('misc/GLOBALS','H/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']),
file_filter_with_init('misc/GLOBALS','H/rglobals.h',gen_hstruct,Warning,['rglobals.h','GLOBALS']),
file_filter_with_init('misc/GLOBALS','H/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']).
warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildheap\"~n please do not update, update misc/~a instead */~n~n').
/* define the field */

2
packages/jpl

@ -1 +1 @@
Subproject commit 9efaf4ce7063fbdae534b4555a80fa1373bb7e9a
Subproject commit 3823a8b909e99c8f0a581d14c9505a4fbd9a2853