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

remove abort_yapor, abort_yaptab, ...

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1309 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc 2005-05-31 00:49:49 +00:00
parent 1f2af700d2
commit f1db3d3b69
14 changed files with 446 additions and 430 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
OPTYap/opt.config.h
View File

@ -5,7 +5,7 @@
#define MAX_LENGTH_ANSWER 500
#define MAX_DEPTH 1000
#define MAX_BEST_TIMES 21
#define MAX_TABLE_VARS 1000
#define MAX_TABLE_VARS 100
#define TABLE_LOCK_BUCKETS 512
#define TG_ANSWER_SLOTS 20

6
OPTYap/opt.init.c
View File

@ -226,7 +226,8 @@ void init_workers(void) {
if (number_workers > 1) {
int son;
son = fork();
if (son == -1) abort_yapor("fork error in function init_workers");
if (son == -1)
Yap_Error(FATAL_ERROR, TermNil, "fork error (init_workers)");
if (son > 0) {
/* I am the father, I must stay here and wait for my children to all die */
struct sigaction sigact;
@ -244,7 +245,8 @@ void init_workers(void) {
for (proc = 1; proc < number_workers; proc++) {
int son;
son = fork();
if (son == -1) abort_yapor("fork error in function init_workers");
if (son == -1)
Yap_Error(FATAL_ERROR, TermNil, "fork error (init_workers)");
if (son == 0) {
/* new worker */
worker_id = proc;

62
OPTYap/opt.macros.h
View File

@ -35,33 +35,48 @@ extern int Yap_page_size;
#define ALLOC_BLOCK(BLOCK, SIZE) \
BLOCK = malloc(SIZE)
#define FREE_BLOCK(BLOCK) \
#define ALLOC_BLOCK(BLOCK, SIZE) \
if ((BLOCK = malloc(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_BLOCK)")
/* BLOCK = (void *) Yap_AllocCodeSpace(SIZE) */
#define FREE_BLOCK(BLOCK) \
free(BLOCK)
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
/* Yap_FreeCodeSpace((char *) (BLOCK)) */
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
if ((STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_STRUCT)")
#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) \
free(STR)
/*
#define ALLOC_BLOCK(BLOCK, SIZE) \
BLOCK = (void *) Yap_AllocCodeSpace(SIZE)
#define FREE_BLOCK(BLOCK) \
Yap_FreeCodeSpace((char *) (BLOCK))
#include <sys/shm.h>
#define SHMMAX 0x2000000
#define ALLOC_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
ALLOC_BLOCK(PG_HD, Yap_page_size); \
UPDATE_STATS(Pg_str_alloc(GLOBAL_PAGES_void), 1); \
} else { \
PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \
Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \
} \
#define ALLOC_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
int i, shmid; \
pg_hd_ptr pg_hd, aux_pg_hd; \
if ((shmid = shmget(IPC_PRIVATE, SHMMAX, SHM_R|SHM_W)) == -1) \
Yap_Error(FATAL_ERROR, TermNil, "shmget error (ALLOC_PAGE)"); \
if ((pg_hd = (pg_hd_ptr) shmat(shmid, NULL, 0)) == (void *) -1) \
Yap_Error(FATAL_ERROR, TermNil, "shmat error (ALLOC_PAGE)"); \
if (shmctl(shmid, IPC_RMID, 0) != 0) \
Yap_Error(FATAL_ERROR, TermNil, "shmctl error (ALLOC_PAGE)"); \
Pg_free_pg(GLOBAL_PAGES_void) = pg_hd; \
for (i = 1; i < SHMMAX / Yap_page_size; i++) { \
aux_pg_hd = (pg_hd_ptr)(((void *)pg_hd) + Yap_page_size); \
PgHd_next(pg_hd) = aux_pg_hd; \
pg_hd = aux_pg_hd; \
} \
PgHd_next(pg_hd) = NULL; \
UPDATE_STATS(Pg_str_alloc(GLOBAL_PAGES_void), SHMMAX / Yap_page_size); \
} \
PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \
Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \
UNLOCK(Pg_lock(GLOBAL_PAGES_void))
#define FREE_PAGE(PG_HD) \
@ -174,7 +189,6 @@ extern int Yap_page_size;
} \
}
*/
#define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **ptr; \
ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \

33
OPTYap/opt.memory.c
View File

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

30
OPTYap/opt.misc.c
View File

@ -33,31 +33,6 @@ struct worker WORKER;
** Global functions **
** -------------------------- */
#ifdef TABLING
void abort_yaptab(const char *msg, ...) {
va_list args;
va_start(args, msg);
fprintf(stderr, "%% YAPTAB FATAL ERROR: ");
vfprintf(stderr, msg, args);
fprintf(stderr, "\n");
exit (1);
}
#endif /* TABLING */
#ifdef YAPOR
void abort_yapor(const char *msg, ...) {
va_list args;
va_start(args, msg);
fprintf(stderr, "%% YAPOR FATAL ERROR: ");
vfprintf(stderr, msg, args);
fprintf(stderr, " (worker %d exiting...)\n", worker_id);
unmap_memory();
exit (1);
}
#endif /* YAPOR */
void itos(int i, char *s) {
int n,r,j;
n = 10;
@ -91,13 +66,12 @@ void error_message(const char *mesg, ...) {
#ifdef YAPOR
LOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR */
fprintf(stderr, "[ ");
fprintf(stderr, "% POTENCIAL ERROR- ");
#ifdef YAPOR
fprintf(stderr, "W%d: ", worker_id);
#endif /* YAPOR */
fprintf(stderr, "Potencial Error -> ");
vfprintf(stderr, mesg, args);
fprintf(stderr, " ]\n");
fprintf(stderr, "\n");
#ifdef YAPOR
UNLOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR */

4
OPTYap/opt.preds.c
View File

@ -890,7 +890,11 @@ int p_debug_prolog(void) {
if (IsAtomTerm(t)) {
char *s;
s = RepAtom(AtomOfTerm(t))->StrOfAE;
#ifdef YAPOR_ERRORS
fprintf(stdout, "W%d: %s\n", worker_id, s);
#else /* TABLING_ERRORS */
fprintf(stdout, "%s\n", s);
#endif /* YAPOR_ERRORS */
return(TRUE);
} else {
return (FALSE);

6
OPTYap/opt.proto.h
View File

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

2
OPTYap/or.cowengine.c
View File

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

18
OPTYap/or.engine.c
View File

@ -438,7 +438,7 @@ void share_private_nodes(int worker_q) {
choiceptr consumer_cp, next_node_on_branch;
dep_fr_ptr dep_frame;
sg_fr_ptr sg_frame;
CELL *stack, *stack_base, *stack_top;
CELL *stack, *stack_base, *stack_limit;
/* find top dependency frame above current choice point */
dep_frame = LOCAL_top_dep_fr;
@ -448,8 +448,8 @@ void share_private_nodes(int worker_q) {
/* initialize tabling auxiliary variables */
consumer_cp = DepFr_cons_cp(dep_frame);
next_node_on_branch = NULL;
stack_top = (CELL *)TrailTop;
stack_base = stack = AuxSp;
stack_limit = (CELL *)TR;
stack_base = stack = (CELL *)Yap_TrailTop;
#endif /* TABLING */
/* initialize auxiliary variables */
@ -537,8 +537,10 @@ void share_private_nodes(int worker_q) {
/* frozen stack segment */
if (! next_node_on_branch)
next_node_on_branch = sharing_node;
STACK_PUSH(or_frame, stack, stack_top, stack_base);
STACK_PUSH(sharing_node, stack, stack_top, stack_base);
STACK_PUSH_UP(or_frame, stack);
STACK_CHECK_EXPAND1(stack, stack_limit, stack_base);
STACK_PUSH(sharing_node, stack);
STACK_CHECK_EXPAND1(stack, stack_limit, stack_base);
sharing_node = consumer_cp;
dep_frame = DepFr_next(dep_frame);
consumer_cp = DepFr_cons_cp(dep_frame);
@ -567,15 +569,15 @@ void share_private_nodes(int worker_q) {
#ifdef TABLING
/* update or-frames stored in auxiliary stack */
while (STACK_NOT_EMPTY(stack, stack_base)) {
next_node_on_branch = (choiceptr) STACK_POP(stack);
or_frame = (or_fr_ptr) STACK_POP(stack);
next_node_on_branch = (choiceptr) STACK_POP_DOWN(stack);
or_frame = (or_fr_ptr) STACK_POP_DOWN(stack);
OrFr_nearest_livenode(or_frame) = OrFr_next(or_frame) = next_node_on_branch->cp_or_fr;
}
#endif /* TABLING */
/* update depth */
if (depth >= MAX_DEPTH)
abort_yapor("maximum depth exceded (%d/%d) (share_private_nodes)", depth, MAX_DEPTH);
Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)");
or_frame = B->cp_or_fr;
#ifdef TABLING
previous_or_frame = LOCAL_top_cp_on_stack->cp_or_fr;

2
OPTYap/or.sbaengine.c
View File

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

307
OPTYap/tab.insts.i
View File

@ -2,51 +2,68 @@
** Tabling instructions: auxiliary macros **
** ------------------------------------------------ */
#define store_generator_node(ARITY, AP, SG_FR) \
{ register CELL *pt_args; \
register choiceptr gcp; \
/* store args */ \
pt_args = XREGS + (ARITY); \
while (pt_args > XREGS) { \
register CELL aux_arg = pt_args[0]; \
--YENV; \
--pt_args; \
*YENV = aux_arg; \
} \
/* initialize gcp and adjust subgoal frame field */ \
YENV = (CELL *) (GEN_CP(YENV) - 1); \
gcp = NORM_CP(YENV); \
SgFr_gen_cp(SG_FR) = gcp; \
/* store generator choice point */ \
HBREG = H; \
store_yaam_reg_cpdepth(gcp); \
gcp->cp_tr = TR; \
gcp->cp_ap = (yamop *)(AP); \
gcp->cp_h = H; \
gcp->cp_b = B; \
gcp->cp_env = ENV; \
gcp->cp_cp = CPREG; \
if (yap_flags[TABLING_MODE_FLAG] != TABLING_MODE_LOCAL && \
(!(PREG->u.ld.p->PredFlags & LocalSchedPredFlag) || \
yap_flags[TABLING_MODE_FLAG] == TABLING_MODE_BATCHED)) { \
GEN_CP(gcp)->cp_dep_fr = NULL; \
} else { \
register dep_fr_ptr new_dep_fr; \
/* adjust freeze registers */ \
H_FZ = H; \
B_FZ = gcp; \
TR_FZ = TR; \
/* store dependency frame */ \
new_dependency_frame(new_dep_fr, TRUE, LOCAL_top_or_fr, \
gcp, gcp, SG_FR, LOCAL_top_dep_fr); \
LOCAL_top_dep_fr = new_dep_fr; \
GEN_CP(gcp)->cp_dep_fr = LOCAL_top_dep_fr; \
} \
GEN_CP(gcp)->cp_sg_fr = SG_FR; \
set_cut((CELL *)gcp, B); \
B = gcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
#ifdef TABLING_ERRORS
#define TABLING_ERRORS_check_stack \
if (Unsigned(H) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H + 1024 > B (check_stack)")
#else
#define TABLING_ERRORS_check_stack
#endif /* TABLING_ERRORS */
#define store_generator_node(ARITY, AP, SG_FR) \
{ register int subs_arity = *YENV; \
register CELL *pt_args; \
register choiceptr gcp; \
/* store args */ \
pt_args = XREGS + (ARITY); \
while (pt_args > XREGS) { \
register CELL aux_arg = pt_args[0]; \
--YENV; \
--pt_args; \
*YENV = aux_arg; \
} \
/* initialize gcp and adjust subgoal frame field */ \
YENV = (CELL *) (GEN_CP(YENV) - 1); \
gcp = NORM_CP(YENV); \
SgFr_gen_cp(SG_FR) = gcp; \
/* store generator choice point */ \
HBREG = H; \
store_yaam_reg_cpdepth(gcp); \
gcp->cp_tr = TR; \
gcp->cp_ap = (yamop *)(AP); \
gcp->cp_h = H; \
gcp->cp_b = B; \
gcp->cp_env = ENV; \
gcp->cp_cp = CPREG; \
\
\
/*if (SgFr_abolish(SG_FR) == 0) {*/ \
if (subs_arity == 0 || \
(yap_flags[TABLING_MODE_FLAG] != TABLING_MODE_LOCAL && \
(!(PREG->u.ld.p->PredFlags & LocalSchedPredFlag) || \
yap_flags[TABLING_MODE_FLAG] == TABLING_MODE_BATCHED))) { \
\
\
/* go batched */ \
GEN_CP(gcp)->cp_dep_fr = NULL; \
} else { \
/* go local */ \
register dep_fr_ptr new_dep_fr; \
/* adjust freeze registers */ \
H_FZ = H; \
B_FZ = gcp; \
TR_FZ = TR; \
/* store dependency frame */ \
new_dependency_frame(new_dep_fr, TRUE, LOCAL_top_or_fr, \
gcp, gcp, SG_FR, LOCAL_top_dep_fr); \
LOCAL_top_dep_fr = new_dep_fr; \
GEN_CP(gcp)->cp_dep_fr = LOCAL_top_dep_fr; \
} \
GEN_CP(gcp)->cp_sg_fr = SG_FR; \
set_cut((CELL *)gcp, B); \
B = gcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
}
@ -125,9 +142,16 @@
B = ccp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
}
#ifdef TABLING_ERRORS
#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_consume_answer_and_procceed
#endif /* TABLING_ERRORS */
#define consume_answer_and_procceed(DEP_FR, ANSWER) \
{ CELL *subs_ptr; \
/* restore consumer choice point */ \
@ -142,7 +166,7 @@
if (B == DepFr_leader_cp(DEP_FR)) { \
/* B is a generator-consumer node */ \
/* never here if batched scheduling */ \
if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n"); \
TABLING_ERRORS_consume_answer_and_procceed; \
subs_ptr = (CELL *) (GEN_CP(B) + 1); \
subs_ptr += SgFr_arity(GEN_CP(B)->cp_sg_fr); \
} else { \
@ -155,19 +179,20 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
}
#ifdef DEPTH_LIMIT
#define allocate_environment(PTR) \
PTR[E_CP] = (CELL) CPREG; \
PTR[E_E] = (CELL) ENV; \
PTR[E_DEPTH] = (CELL)DEPTH; \
PTR[E_B] = (CELL) B; \
ENV = PTR
#define allocate_environment() \
YENV[E_CP] = (CELL) CPREG; \
YENV[E_E] = (CELL) ENV; \
YENV[E_B] = (CELL) B; \
YENV[E_DEPTH] = (CELL)DEPTH; \
ENV = YENV
#else
#define allocate_environment(PTR) \
PTR[E_CP] = (CELL) CPREG; \
PTR[E_E] = (CELL) ENV; \
PTR[E_B] = (CELL) B; \
ENV = PTR
#endif
#define allocate_environment() \
YENV[E_CP] = (CELL) CPREG; \
YENV[E_E] = (CELL) ENV; \
YENV[E_B] = (CELL) B; \
ENV = YENV
#endif /* DEPTH_LIMIT */
/* ------------------------------ **
@ -176,7 +201,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
#ifdef TABLING_INNER_CUTS
Op(clause_with_cut, e)
/*printf("ricroc - clause_with_cut\n");*/
if (LOCAL_pruning_scope) {
if (YOUNGER_CP(LOCAL_pruning_scope, B))
LOCAL_pruning_scope = B;
@ -194,30 +218,19 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
PBOp(table_try_single, ld)
tab_ent_ptr tab_ent;
sg_fr_ptr sg_fr;
CELL *Yaddr;
/*printf("ricroc - table_try_single\n");*/
Yaddr = YENV;
check_trail();
tab_ent = PREG->u.ld.te;
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
LOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
sg_fr = subgoal_search(tab_ent, PREG->u.ld.s, &Yaddr);
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
UNLOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
YENV = Yaddr;
sg_fr = subgoal_search(tab_ent, PREG->u.ld.s, &YENV);
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == ready) {
if (SgFr_state(sg_fr) == start) {
/* subgoal new or abolished */
init_subgoal_frame(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
store_generator_node(PREG->u.ld.s, COMPLETION, sg_fr);
/* PREG = PREG->u.ld.d; */
PREG = NEXTOP(PREG,ld);
PREG = NEXTOP(PREG,ld); /* PREG = PREG->u.ld.d; */
PREFETCH_OP(PREG);
allocate_environment(YENV);
allocate_environment();
GONext();
} else if (SgFr_state(sg_fr) == evaluating) {
/* subgoal in evaluation */
@ -245,20 +258,22 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
goto answer_resolution;
} else {
/* subgoal completed */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
if (SgFr_first_answer(sg_fr) == NULL) {
/* no answers --> fail */
UNLOCK(SgFr_lock(sg_fr));
goto fail;
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
@ -273,29 +288,19 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
PBOp(table_try_me, ld)
tab_ent_ptr tab_ent;
sg_fr_ptr sg_fr;
CELL *Yaddr;
/*printf("ricroc - table_try_me\n");*/
Yaddr = YENV;
check_trail();
tab_ent = PREG->u.ld.te;
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
LOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
sg_fr = subgoal_search(tab_ent, PREG->u.ld.s, &Yaddr);
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
UNLOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
YENV = Yaddr;
sg_fr = subgoal_search(tab_ent, PREG->u.ld.s, &YENV);
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == ready) {
if (SgFr_state(sg_fr) == start) {
/* subgoal new or abolished */
init_subgoal_frame(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
store_generator_node(PREG->u.ld.s, PREG->u.ld.d, sg_fr);
PREG = NEXTOP(PREG, ld);
PREFETCH_OP(PREG);
allocate_environment(YENV);
allocate_environment();
GONext();
} else if (SgFr_state(sg_fr) == evaluating) {
/* subgoal in evaluation */
@ -323,20 +328,22 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
goto answer_resolution;
} else {
/* subgoal completed */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
if (SgFr_first_answer(sg_fr) == NULL) {
/* no answers --> fail */
UNLOCK(SgFr_lock(sg_fr));
goto fail;
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
@ -350,29 +357,19 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
PBOp(table_try, ld)
tab_ent_ptr tab_ent;
sg_fr_ptr sg_fr;
CELL *Yaddr;
/*printf("ricroc - table_try\n");*/
Yaddr = YENV;
check_trail();
tab_ent = PREG->u.ld.te;
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
LOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
sg_fr = subgoal_search(tab_ent, PREG->u.ld.s, &Yaddr);
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
UNLOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
YENV = Yaddr;
sg_fr = subgoal_search(tab_ent, PREG->u.ld.s, &YENV);
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == ready) {
if (SgFr_state(sg_fr) == start) {
/* subgoal new or abolished */
init_subgoal_frame(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
store_generator_node(PREG->u.ld.s, NEXTOP(PREG,ld), sg_fr);
PREG = PREG->u.ld.d;
PREFETCH_OP(PREG);
allocate_environment(YENV);
allocate_environment();
GONext();
} else if (SgFr_state(sg_fr) == evaluating) {
/* subgoal in evaluation */
@ -389,31 +386,33 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
while (YOUNGER_CP(aux_cp, 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_MESSAGE("Error on DepFr_top_or_fr (table_try)");
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_MESSAGE("Error on DepFr_leader_cp (table_try)");
}
#endif /* OPTYAP_ERRORS */
goto answer_resolution;
} else {
/* subgoal completed */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
if (SgFr_first_answer(sg_fr) == NULL) {
/* no answers --> fail */
UNLOCK(SgFr_lock(sg_fr));
goto fail;
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
/* answers -> load first answer */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
@ -426,24 +425,22 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
Op(table_retry, ld)
/*printf("ricroc - table_retry\n");*/
restore_generator_node(PREG->u.ld.s, NEXTOP(PREG,ld));
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment(YENV);
allocate_environment();
PREG = PREG->u.ld.d;
GONext();
ENDOp();
Op(table_retry_me, ld)
/*printf("ricroc - table_retry_me\n");*/
restore_generator_node(PREG->u.ld.s, PREG->u.ld.d);
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment(YENV);
allocate_environment();
PREG = NEXTOP(PREG,ld);
GONext();
ENDOp();
@ -451,23 +448,21 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
Op(table_trust_me, ld)
/*printf("ricroc - table_trust_me\n");*/
restore_generator_node(PREG->u.ld.s, COMPLETION);
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment(YENV);
allocate_environment();
PREG = NEXTOP(PREG,ld);
GONext();
ENDOp();
Op(table_trust, ld)
/*printf("ricroc - table_trust\n");*/
restore_generator_node(PREG->u.ld.s, COMPLETION);
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment(YENV);
allocate_environment();
PREG = PREG->u.ld.d;
GONext();
ENDOp();
@ -479,7 +474,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
sg_fr_ptr sg_fr;
ans_node_ptr ans_node;
/*printf("ricroc - table_new_answer\n");*/
/* possible optimization: when the number of substitution variables **
** is zero, an answer is sufficient to perform an early completion */
gcp = NORM_CP(YENV[E_B]);
@ -569,6 +563,9 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
CPREG = PREG;
SREG = YENV;
ENV = YENV = (CELL *) YENV[E_E];
#ifdef DEPTH_LIMIT
DEPTH = YENV[E_DEPTH];
#endif /* DEPTH_LIMIT */
GONext();
} else {
/* fail */
@ -655,11 +652,10 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
UNLOCK_TABLE(ans_node);
LOCK(SgFr_lock(sg_fr));
#endif /* TABLE_LOCK_LEVEL */
if (SgFr_first_answer(sg_fr) == NULL) {
SgFr_first_answer(sg_fr) = ans_node;
} else {
if (SgFr_first_answer(sg_fr) == NULL)
SgFr_first_answer(sg_fr) = ans_node;
else
TrNode_child(SgFr_last_answer(sg_fr)) = ans_node;
}
SgFr_last_answer(sg_fr) = ans_node;
#ifdef TABLING_ERRORS
{
@ -679,6 +675,9 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
CPREG = PREG;
SREG = YENV;
ENV = YENV = (CELL *) YENV[E_E];
#ifdef DEPTH_LIMIT
DEPTH = YENV[E_DEPTH];
#endif /* DEPTH_LIMIT */
GONext();
} else {
/* fail */
@ -700,7 +699,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
BOp(table_answer_resolution, ld)
/*printf("ricroc - table_answer_resolution\n");*/
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
@ -709,8 +707,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
answer_resolution:
INIT_PREFETCH()
dep_fr_ptr dep_fr;
ans_node_ptr ans_node;
@ -730,14 +726,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
if (TrNode_child(ans_node)) {
/* unconsumed answer */
ans_node = DepFr_last_answer(dep_fr) = TrNode_child(ans_node);
/* ricroc - obsolete
if (ans_node != SgFr_last_answer(DepFr_sg_fr(dep_fr))) {
if (ans_node == NULL) {
ans_node = DepFr_last_answer(dep_fr) = SgFr_first_answer(DepFr_sg_fr(dep_fr));
} else {
ans_node = DepFr_last_answer(dep_fr) = TrNode_child(ans_node);
}
*/
UNLOCK(DepFr_lock(dep_fr));
consume_answer_and_procceed(dep_fr, ans_node);
}
@ -747,6 +735,10 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
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 */
goto completion;
}
#endif /* YAPOR */
@ -788,14 +780,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
if (TrNode_child(ans_node)) {
/* dependency frame with unconsumed answers */
ans_node = DepFr_last_answer(dep_fr) = TrNode_child(ans_node);
/* ricroc - obsolete
if (ans_node != SgFr_last_answer(DepFr_sg_fr(dep_fr))) {
if (ans_node == NULL) {
ans_node = DepFr_last_answer(dep_fr) = SgFr_first_answer(DepFr_sg_fr(dep_fr));
} else {
ans_node = DepFr_last_answer(dep_fr) = TrNode_child(ans_node);
}
*/
#ifdef YAPOR
if (YOUNGER_CP(DepFr_backchain_cp(dep_fr), top_chain_cp))
#endif /* YAPOR */
@ -1001,7 +985,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
BOp(table_completion, ld);
/*printf("ricroc - table_completion\n");*/
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
if (IS_BATCHED_GEN_CP(B)) {
@ -1040,8 +1023,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
completion:
/*printf("ricroc - completion\n");*/
INIT_PREFETCH()
dep_fr_ptr dep_fr;
ans_node_ptr ans_node;
@ -1067,14 +1048,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
if (TrNode_child(ans_node)) {
/* dependency frame with unconsumed answers */
ans_node = DepFr_last_answer(dep_fr) = TrNode_child(ans_node);
/* ricroc - obsolete
if (ans_node != SgFr_last_answer(DepFr_sg_fr(dep_fr))) {
if (ans_node == NULL) {
ans_node = DepFr_last_answer(dep_fr) = SgFr_first_answer(DepFr_sg_fr(dep_fr));
} else {
ans_node = DepFr_last_answer(dep_fr) = TrNode_child(ans_node);
}
*/
if (B->cp_ap) {
#ifdef YAPOR
if (YOUNGER_CP(DepFr_backchain_cp(dep_fr), B))
@ -1252,7 +1225,10 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
/* B is a generator-consumer node */
/* never here if batched scheduling */
ans_node_ptr ans_node;
if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
#ifdef TABLING_ERRORS
if (IS_BATCHED_GEN_CP(B))
TABLING_ERROR_MESSAGE("IS_BATCHED_GEN_CP(B) (completion)");
#endif /* TABLING_ERRORS */
TR = B->cp_tr;
SET_BB(B);
LOCK_OR_FRAME(LOCAL_top_or_fr);
@ -1262,15 +1238,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
/* unconsumed answer */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
ans_node = DepFr_last_answer(LOCAL_top_dep_fr) = TrNode_child(ans_node);
/* ricroc - obsolete
if (ans_node != SgFr_last_answer(DepFr_sg_fr(LOCAL_top_dep_fr))) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
if (ans_node == NULL) {
ans_node = DepFr_last_answer(LOCAL_top_dep_fr) = SgFr_first_answer(DepFr_sg_fr(LOCAL_top_dep_fr));
} else {
ans_node = DepFr_last_answer(LOCAL_top_dep_fr) = TrNode_child(ans_node);
}
*/
UNLOCK(DepFr_lock(LOCAL_top_dep_fr));
consume_answer_and_procceed(LOCAL_top_dep_fr, ans_node);
}
@ -1322,10 +1289,6 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
goto fail;
} else {
/* subgoal completed */
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
if (SgFr_first_answer(sg_fr) == NULL) {
/* no answers --> fail */
B = B->cp_b;
@ -1349,6 +1312,10 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
GONext();
} else {
/* answers -> load first answer */
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */

140
OPTYap/tab.macros.h
View File

@ -12,12 +12,12 @@ STD_PROTO(static inline void mark_as_completed, (sg_fr_ptr));
STD_PROTO(static inline void unbind_variables, (tr_fr_ptr, tr_fr_ptr));
STD_PROTO(static inline void rebind_variables, (tr_fr_ptr, tr_fr_ptr));
STD_PROTO(static inline void restore_bindings, (tr_fr_ptr, tr_fr_ptr));
STD_PROTO(static inline void pruning_over_tabling_data_structures, (void));
STD_PROTO(static inline void abolish_incomplete_subgoals, (choiceptr));
STD_PROTO(static inline void free_subgoal_hash_chain, (sg_hash_ptr));
STD_PROTO(static inline void free_answer_hash_chain, (ans_hash_ptr));
#ifdef YAPOR
STD_PROTO(static inline void pruning_over_tabling_data_structures, (void));
STD_PROTO(static inline void collect_suspension_frames, (or_fr_ptr));
#ifdef TIMESTAMP_CHECK
STD_PROTO(static inline susp_fr_ptr suspension_frame_to_resume, (or_fr_ptr, long));
@ -52,7 +52,7 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
#define TabNumberTagBits NumberTag
#define TabPairTagBits MKTAG(0x5,3)
#define TabApplTagBits MKTAG(0x5,0)
#else
#else /* Tags_32LowTag.h */
#define TabTagBits MKTAG(0x0,LowTagBits)
#define TabNumberOfLowTagBits LowTagBits
#define TabVarTagBits MKTAG(0x0,0)
@ -73,30 +73,53 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
#define UNTAG_ANSWER_LEAF_NODE(NODE) ((ans_node_ptr)((unsigned int)NODE & 0xfffffffe))
#define IS_ANSWER_LEAF_NODE(NODE) ((unsigned int)TrNode_parent(NODE) & 0x1)
#define FREE_STACK_PUSH(ITEM, STACK) *--STACK = (CELL)(ITEM)
#define STACK_TOP(STACK) *STACK
#define STACK_POP(STACK) *STACK++
#define STACK_EMPTY(STACK, STACK_BASE) STACK == STACK_BASE
#define STACK_NOT_EMPTY(STACK, STACK_BASE) STACK != STACK_BASE
#define STACK_PUSH_UP(ITEM, STACK) *--STACK = (CELL)(ITEM)
#define STACK_POP_DOWN(STACK) *STACK++
#define STACK_PUSH_DOWN(ITEM, STACK) *STACK++ = (CELL)(ITEM)
#define STACK_POP_UP(STACK) *--STACK
#ifdef YAPOR
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
*--STACK = (CELL)(ITEM); \
if (STACK <= STACK_TOP) \
abort_yapor("auxiliary stack full")
#define STACK_CHECK_EXPAND1(STACK, STACK_LIMIT, STACK1) \
if (STACK_LIMIT >= STACK) { \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND1)")
#define STACK_CHECK_EXPAND3(STACK, STACK_LIMIT, STACK1, STACK2, STACK3) \
if (STACK_LIMIT >= STACK) { \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND3)")
#else
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
*--(STACK) = (CELL)(ITEM); \
if ((STACK) <= STACK_TOP + 1024) { \
void *old_top = Yap_TrailTop; \
CELL *NEW_STACK; \
UInt diff; \
abort_yaptab("auxiliary stack full"); \
Yap_growtrail(64 * 1024L, TRUE); \
diff = (void *)Yap_TrailTop - old_top; \
NEW_STACK = (CELL *)((void *)(STACK) + diff); \
memmove((void *)NEW_STACK, (void *)(STACK), old_top - (void *)STACK); \
(STACK) = NEW_STACK; \
(STACK_BASE) = (CELL *)((void *)(STACK_BASE) + diff); \
#define STACK_CHECK_EXPAND1(STACK, STACK_LIMIT, STACK1) \
if (STACK_LIMIT >= STACK) { \
void *old_top; \
UInt diff; \
CELL *NEW_STACK; \
if (STACK_LIMIT > STACK) \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND1)"); \
INFORMATION_MESSAGE("Expanding trail in 64 Mbytes"); \
old_top = Yap_TrailTop; \
Yap_growtrail(64 * 1024L, TRUE); \
diff = (void *)Yap_TrailTop - old_top; \
NEW_STACK = (CELL *)((void *)STACK + diff); \
memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \
STACK = NEW_STACK; \
STACK1 = (CELL *)((void *)STACK1 + diff); \
}
#define STACK_CHECK_EXPAND3(STACK, STACK_LIMIT, STACK1, STACK2, STACK3) \
if (STACK_LIMIT >= STACK) { \
void *old_top; \
UInt diff; \
CELL *NEW_STACK; \
if (STACK_LIMIT > STACK) \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND3)"); \
INFORMATION_MESSAGE("Expanding trail in 64 Mbytes"); \
old_top = Yap_TrailTop; \
Yap_growtrail(64 * 1024L, TRUE); \
diff = (void *)Yap_TrailTop - old_top; \
NEW_STACK = (CELL *)((void *)STACK + diff); \
memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \
STACK = NEW_STACK; \
STACK1 = (CELL *)((void *)STACK1 + diff); \
STACK2 = (CELL *)((void *)STACK2 + diff); \
STACK3 = (CELL *)((void *)STACK3 + diff); \
}
#endif /* YAPOR */
@ -236,8 +259,9 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
INIT_LOCK(SgFr_lock(SG_FR)); \
new_answer_trie_node(ans_node, 0, 0, NULL, NULL, NULL); \
SgFr_answer_trie(SG_FR) = ans_node; \
SgFr_state(SG_FR) = ready; \
SgFr_abolished(SG_FR) = 0; \
SgFr_hash_chain(SG_FR) = NULL; \
SgFr_state(SG_FR) = start; \
SgFr_abolish(SG_FR) = 0; \
SgFr_arity(SG_FR) = ARITY; \
}
@ -246,7 +270,6 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
{ SgFr_init_yapor_fields(SG_FR); \
SgFr_first_answer(SG_FR) = NULL; \
SgFr_last_answer(SG_FR) = NULL; \
SgFr_hash_chain(SG_FR) = NULL; \
SgFr_state(SG_FR) = evaluating; \
SgFr_next(SG_FR) = LOCAL_top_sg_fr; \
LOCAL_top_sg_fr = sg_fr; \
@ -336,13 +359,8 @@ void adjust_freeze_registers(void) {
static inline
void mark_as_completed(sg_fr_ptr sg_fr) {
ans_hash_ptr hash;
LOCK(SgFr_lock(sg_fr));
hash = SgFr_hash_chain(sg_fr);
SgFr_hash_chain(sg_fr) = NULL;
SgFr_state(sg_fr) = complete;
free_answer_hash_chain(hash);
UNLOCK(SgFr_lock(sg_fr));
return;
}
@ -367,8 +385,8 @@ void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
/* avoid frozen segments */
unbind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (unbind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("unbind_tr > TrailTop (function unbind_variables)");
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 */
@ -405,8 +423,8 @@ void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
/* avoid frozen segments */
rebind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (rebind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("rebind_tr > TrailTop (function rebind_variables)");
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 */
@ -448,8 +466,8 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
if ((ADDR)ref >= Yap_TrailBase) {
unbind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (unbind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("unbind_tr > TrailTop (function restore_bindings)");
if (unbind_tr > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("unbind_tr > Yap_TrailTop (function restore_bindings)");
#endif /* TABLING_ERRORS */
}
}
@ -462,8 +480,8 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
if ((ADDR)ref >= Yap_TrailBase) {
end_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (end_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("end_tr > TrailTop (function restore_bindings)");
if (end_tr > (tr_fr_ptr) Yap_TrailTop)
TABLING_ERROR_MESSAGE("end_tr > Yap_TrailTop (function restore_bindings)");
#endif /* TABLING_ERRORS */
}
}
@ -479,8 +497,8 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
if ((ADDR)ref >= Yap_TrailBase) {
rebind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (rebind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("rebind_tr > TrailTop (function restore_bindings)");
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 */
@ -491,13 +509,6 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
}
static inline
void pruning_over_tabling_data_structures(void) {
abort_yaptab("pruning over tabling data structures");
return;
}
static inline
void abolish_incomplete_subgoals(choiceptr prune_cp) {
#ifdef YAPOR
@ -520,7 +531,6 @@ void abolish_incomplete_subgoals(choiceptr prune_cp) {
while (LOCAL_top_sg_fr && EQUAL_OR_YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), prune_cp)) {
sg_fr_ptr sg_fr;
ans_node_ptr node;
#ifdef YAPOR
if (PARALLEL_EXECUTION_MODE)
pruning_over_tabling_data_structures();
@ -528,15 +538,22 @@ void abolish_incomplete_subgoals(choiceptr prune_cp) {
sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(sg_fr);
LOCK(SgFr_lock(sg_fr));
free_answer_hash_chain(SgFr_hash_chain(sg_fr));
node = TrNode_child(SgFr_answer_trie(sg_fr));
TrNode_child(SgFr_answer_trie(sg_fr)) = NULL;
TrNode_parent(SgFr_answer_trie(sg_fr)) = NULL;
SgFr_state(sg_fr) = ready;
SgFr_abolished(sg_fr)++;
UNLOCK(SgFr_lock(sg_fr));
if (node)
free_answer_trie_branch(node);
if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
/* yes answer --> complete */
SgFr_state(sg_fr) = complete;
UNLOCK(SgFr_lock(sg_fr));
} else {
ans_node_ptr node;
SgFr_state(sg_fr) = start;
SgFr_abolish(sg_fr)++;
free_answer_hash_chain(SgFr_hash_chain(sg_fr));
SgFr_hash_chain(sg_fr) = NULL;
node = TrNode_child(SgFr_answer_trie(sg_fr));
TrNode_child(SgFr_answer_trie(sg_fr)) = NULL;
UNLOCK(SgFr_lock(sg_fr));
if (node)
free_answer_trie_branch(node);
}
}
return;
@ -602,6 +619,13 @@ void free_answer_hash_chain(ans_hash_ptr hash) {
#ifdef YAPOR
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) {
int depth;

8
OPTYap/tab.structs.h
View File

@ -107,12 +107,12 @@ typedef struct subgoal_frame {
struct answer_trie_node *last_answer;
struct answer_hash *hash_chain;
enum {
ready = 0,
start = 0,
evaluating = 1,
complete = 2,
executable = 3
} state_flag;
int abolished_operations;
int abolish_operations;
int subgoal_arity;
struct subgoal_frame *next;
} *sg_fr_ptr;
@ -126,7 +126,7 @@ typedef struct subgoal_frame {
#define SgFr_last_answer(X) ((X)->last_answer)
#define SgFr_hash_chain(X) ((X)->hash_chain)
#define SgFr_state(X) ((X)->state_flag)
#define SgFr_abolished(X) ((X)->abolished_operations)
#define SgFr_abolish(X) ((X)->abolish_operations)
#define SgFr_arity(X) ((X)->subgoal_arity)
#define SgFr_next(X) ((X)->next)
@ -144,7 +144,7 @@ typedef struct subgoal_frame {
SgFr_last_answer: a pointer to the bottom answer trie node of the last available answer.
SgFr_hash_chain: a pointer to the first answer_hash struct for the subgoal in hand.
SgFr_state: a flag that indicates the subgoal state.
SgFr_abolished the number of times the subgoal was abolished.
SgFr_abolish the number of times the subgoal was abolished.
SgFr_arity the arity of the subgoal.
SgFr_next: a pointer to chain between subgoal frames.
** ------------------------------------------------------------------------------------------- */

256
OPTYap/tab.tries.c
View File

@ -653,25 +653,24 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
int i, j, count_vars;
CELL *stack_vars, *stack_terms_top, *stack_terms_base, *stack_terms;
CELL *stack_vars, *stack_terms_limit, *stack_terms_base, *stack_terms;
sg_node_ptr current_sg_node;
sg_fr_ptr sg_fr;
count_vars = 0;
stack_vars = *Yaddr;
#ifdef YAPOR
stack_terms_top = (CELL *)Yap_TrailTop;
stack_terms_base = stack_terms = AuxSp;
#else
stack_terms_top = (CELL *)TR;
stack_terms_limit = (CELL *)TR;
stack_terms_base = stack_terms = (CELL *)Yap_TrailTop;
#endif /* YAPOR */
current_sg_node = TabEnt_subgoal_trie(tab_ent);
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
LOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
for (i = 1; i <= arity; i++) {
STACK_PUSH(XREGS[i], stack_terms, stack_terms_top, stack_terms_base);
STACK_PUSH_UP(XREGS[i], stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
do {
Term t = Deref(STACK_POP(stack_terms));
Term t = Deref(STACK_POP_DOWN(stack_terms));
int tag = t & TabTagBits;
switch (tag) {
case TabVarTagBits:
@ -680,8 +679,8 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t);
} else {
if (count_vars == MAX_TABLE_VARS)
Yap_Error(SYSTEM_ERROR,TermNil,"MAX_TABLE_VARS exceeded in function subgoal_search (%d)", count_vars);
FREE_STACK_PUSH(t, stack_vars);
Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (subgoal_search)");
STACK_PUSH_UP(t, stack_vars);
*((CELL *)t) = GLOBAL_table_var_enumerator(count_vars);
t = MakeTableVarTerm(count_vars);
count_vars++;
@ -694,29 +693,24 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
break;
case TabPairTagBits:
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, TabPairTagBits);
STACK_PUSH(*(RepPair(t) + 1), stack_terms, stack_terms_top, stack_terms_base);
STACK_PUSH(*(RepPair(t)), stack_terms, stack_terms_top, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t)), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
break;
case TabApplTagBits:
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node,
TAGGEDA(TabApplTagBits, FunctorOfTerm(t)));
for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--)
STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base);
for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--) {
STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
}
break;
default:
abort_yaptab("unknown type tag in function subgoal_search");
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (subgoal_search)");
}
} while (STACK_NOT_EMPTY(stack_terms, stack_terms_base));
}
FREE_STACK_PUSH(count_vars, stack_vars);
*Yaddr = stack_vars++;
/* reset variables */
while (count_vars--) {
Term t = STACK_POP(stack_vars);
RESET_VARIABLE(t);
}
#if defined(TABLE_LOCK_AT_NODE_LEVEL)
LOCK(TrNode_lock(current_sg_node));
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
@ -729,41 +723,46 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
} else {
sg_fr = (sg_fr_ptr) TrNode_sg_fr(current_sg_node);
}
#if defined(TABLE_LOCK_AT_NODE_LEVEL)
#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
UNLOCK(TabEnt_lock(tab_ent));
#elif defined(TABLE_LOCK_AT_NODE_LEVEL)
UNLOCK(TrNode_lock(current_sg_node));
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
UNLOCK_TABLE(current_sg_node);
#endif /* TABLE_LOCK_LEVEL */
STACK_PUSH_UP(count_vars, stack_vars);
*Yaddr = stack_vars++;
/* reset variables */
while (count_vars--) {
Term t = STACK_POP_DOWN(stack_vars);
RESET_VARIABLE(t);
}
return sg_fr;
}
ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
int i, j, count_vars, subs_arity;
CELL *stack_vars, *stack_terms_base, *stack_terms_top, *stack_terms;
CELL *stack_vars, *stack_terms_base, *stack_terms;
ans_node_ptr current_ans_node;
count_vars = 0;
subs_arity = *subs_ptr;
stack_vars = AuxSp;
#ifdef YAPOR
stack_terms_top = (CELL *)Yap_TrailTop;
stack_terms_base = stack_terms = stack_vars - MAX_TABLE_VARS;
#else
stack_terms_top = (CELL *)TR;
stack_vars = (CELL *)TR;
stack_terms_base = stack_terms = (CELL *)Yap_TrailTop;
#endif /* YAPOR */
current_ans_node = SgFr_answer_trie(sg_fr);
for (i = subs_arity; i >= 1; i--) {
STACK_PUSH(*(subs_ptr + i), stack_terms, stack_terms_top, stack_terms_base);
STACK_PUSH_UP(*(subs_ptr + i), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
#ifdef TABLING_ERRORS
if ((*stack_terms & TabTagBits) != TabVarTagBits)
TABLING_ERROR_MESSAGE("*stack_terms & TabTagBits != TabVarTagBits (answer_search)");
#endif /* TABLING_ERRORS */
do {
Term t = Deref(STACK_POP(stack_terms));
Term t = Deref(STACK_POP_DOWN(stack_terms));
int tag = t & TabTagBits;
switch (tag) {
case TabVarTagBits:
@ -772,8 +771,9 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_val);
} else {
if (count_vars == MAX_TABLE_VARS)
Yap_Error(SYSTEM_ERROR,TermNil,"MAX_TABLE_VARS exceeded in function answer_search (%d)", count_vars);
FREE_STACK_PUSH(t, stack_vars);
Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search)");
STACK_PUSH_DOWN(t, stack_vars);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
*((CELL *)t) = GLOBAL_table_var_enumerator(count_vars);
t = MakeTableVarTerm(count_vars);
count_vars++;
@ -786,24 +786,28 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
break;
case TabPairTagBits:
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, TabPairTagBits, _trie_retry_list);
STACK_PUSH(*(RepPair(t) + 1), stack_terms, stack_terms_top, stack_terms_base);
STACK_PUSH(*(RepPair(t)), stack_terms, stack_terms_top, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t)), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
break;
case TabApplTagBits:
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, TAGGEDA(TabApplTagBits,
FunctorOfTerm(t)), _trie_retry_struct);
for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--)
STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base);
for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--) {
STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
}
break;
default:
abort_yaptab("unknown type tag in function answer_search");
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search)");
}
} while (STACK_NOT_EMPTY(stack_terms, stack_terms_base));
}
/* reset variables */
while (count_vars--) {
Term t = STACK_POP(stack_vars);
Term t = STACK_POP_UP(stack_vars);
RESET_VARIABLE(t);
}
@ -816,20 +820,16 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
subs_arity = *subs_ptr;
if (subs_arity) {
int i, n_vars = 0;
CELL *stack_vars, *stack_terms, *stack_refs, *stack_refs_base, *stack_top;
CELL *stack_vars_base, *stack_vars, *stack_terms_base, *stack_terms, *stack_refs_base, *stack_refs;
ans_node_ptr aux_parent_node;
#ifdef YAPOR
stack_top = (CELL *)Yap_TrailTop;
stack_vars = stack_terms = AuxSp - MAX_TABLE_VARS;
#else
stack_top = (CELL *)TR;
stack_vars = stack_terms = ((CELL *)Yap_TrailTop)-MAX_TABLE_VARS;
#endif /* YAPOR */
stack_vars_base = stack_vars = (CELL *)TR;
stack_terms_base = stack_terms = (CELL *)Yap_TrailTop;
/* load the new answer from the answer trie to the stack_terms */
aux_parent_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(ans_node));
do {
STACK_PUSH(TrNode_entry(ans_node), stack_terms, stack_top, stack_vars);
STACK_PUSH_UP(TrNode_entry(ans_node), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
ans_node = aux_parent_node;
aux_parent_node = TrNode_parent(aux_parent_node);
} while (aux_parent_node);
@ -842,7 +842,7 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
for (i = subs_arity; i >= 1; i--) {
/* bind the substitution variables with the answer loaded in stack_terms */
CELL *subs_var = (CELL *) *(subs_ptr + i);
Term t = STACK_POP(stack_terms);
Term t = STACK_POP_DOWN(stack_terms);
int tag = t & TabTagBits;
#ifdef TABLING_ERRORS
if ((CELL)subs_var != *subs_var)
@ -852,9 +852,11 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
case TabVarTagBits:
{ int var_index = VarIndexOfTableTerm(t);
if (var_index == n_vars) {
stack_vars[n_vars++] = (CELL) subs_var;
n_vars++;
STACK_PUSH_DOWN(subs_var, stack_vars);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
} else {
Bind(subs_var, stack_vars[var_index]);
Bind(subs_var, stack_vars_base[var_index]);
}
} break;
case TabNumberTagBits:
@ -869,8 +871,10 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
TABLING_ERROR_MESSAGE("*subs_var & TabTagBits != TabPairTagBits (load_answer_trie)");
#endif /* TABLING_ERRORS */
H += 2;
STACK_PUSH(H - 1, stack_refs, stack_top, stack_refs_base);
STACK_PUSH(H - 2, stack_refs, stack_top, stack_refs_base);
STACK_PUSH_UP(H - 1, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
STACK_PUSH_UP(H - 2, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
break;
case TabApplTagBits:
{ /* build a pair term as in function MkApplTerm */
@ -883,23 +887,27 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
#endif /* TABLING_ERRORS */
*H++ = (CELL) f;
H += f_arity;
for (j = 1; j <= f_arity; j++)
STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base);
for (j = 1; j <= f_arity; j++) {
STACK_PUSH_UP(H - j, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
}
} break;
default:
abort_yaptab("unknown type tag in macro load_answer_trie");
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (load_answer_trie)");
}
while (STACK_NOT_EMPTY(stack_refs, stack_refs_base)) {
CELL *ref = (CELL *) STACK_POP(stack_refs);
Term t = STACK_POP(stack_terms);
CELL *ref = (CELL *) STACK_POP_DOWN(stack_refs);
Term t = STACK_POP_DOWN(stack_terms);
int tag = t & TabTagBits;
switch (tag) {
case TabVarTagBits:
{ int var_index = VarIndexOfTableTerm(t);
if (var_index == n_vars) {
stack_vars[n_vars++] = (CELL) ref;
n_vars++;
STACK_PUSH_DOWN(ref, stack_vars);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
}
*ref = stack_vars[var_index];
*ref = stack_vars_base[var_index];
} break;
case TabNumberTagBits:
case TabAtomTagBits:
@ -913,8 +921,10 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
TABLING_ERROR_MESSAGE("*ref & TabTagBits != TabPairTagBits (load_answer_trie)");
#endif /* TABLING_ERRORS */
H += 2;
STACK_PUSH(H - 1, stack_refs, stack_top, stack_refs_base);
STACK_PUSH(H - 2, stack_refs, stack_top, stack_refs_base);
STACK_PUSH_UP(H - 1, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
STACK_PUSH_UP(H - 2, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
break;
case TabApplTagBits:
{ /* build a pair term as in function MkApplTerm */
@ -927,17 +937,19 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
#endif /* TABLING_ERRORS */
*H++ = (CELL) f;
H += f_arity;
for (j = 1; j <= f_arity; j++)
STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base);
for (j = 1; j <= f_arity; j++) {
STACK_PUSH_UP(H - j, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
}
} break;
default:
abort_yaptab("unknown type tag in macro load_answer_trie");
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (load_answer_trie)");
}
}
}
#ifdef TABLING_ERRORS
if (stack_terms != AuxSp - MAX_TABLE_VARS)
TABLING_ERROR_MESSAGE("stack_terms != AuxSp - MAX_TABLE_VARS (load_answer_trie)");
if (stack_terms != (CELL *)Yap_TrailTop)
TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_answer_trie)");
#endif /* TABLING_ERRORS */
}
return;
@ -989,7 +1001,7 @@ void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes) {
missing_nodes += ArityOfFunctor((Functor)NonTagPart(t));
break;
default:
abort_yaptab("unknown type tag in function chain_subgoal_frames");
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (chain_subgoal_frames)");
}
if (missing_nodes) {
free_subgoal_trie_branch(TrNode_child(node), missing_nodes);
@ -1026,6 +1038,9 @@ void free_answer_trie_branch(ans_node_ptr node) {
void update_answer_trie(sg_fr_ptr sg_fr) {
ans_node_ptr node;
free_answer_hash_chain(SgFr_hash_chain(sg_fr));
SgFr_hash_chain(sg_fr) = NULL;
node = TrNode_child(SgFr_answer_trie(sg_fr));
if (node) {
TrNode_instr(node) -= 1;
@ -1043,32 +1058,38 @@ static struct trie_statistics{
int show;
long subgoals;
long subgoals_abolished;
long subgoals_abolish_operations;
long subgoal_trie_nodes;
long subgoal_linear_nodes;
int subgoal_trie_max_depth;
int subgoal_trie_min_depth;
long answers;
long answers_yes;
long answers_no;
long answers_pruned;
long answer_trie_nodes;
long answer_linear_nodes;
int answer_trie_max_depth;
int answer_trie_min_depth;
} trie_stats;
#define TrStat_show trie_stats.show
#define TrStat_subgoals trie_stats.subgoals
#define TrStat_subgoals_abolished trie_stats.subgoals_abolished
#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes
#define TrStat_sg_linear_nodes trie_stats.subgoal_linear_nodes
#define TrStat_sg_max_depth trie_stats.subgoal_trie_max_depth
#define TrStat_sg_min_depth trie_stats.subgoal_trie_min_depth
#define TrStat_answers trie_stats.answers
#define TrStat_answers_pruned trie_stats.answers_pruned
#define TrStat_ans_nodes trie_stats.answer_trie_nodes
#define TrStat_ans_linear_nodes trie_stats.answer_linear_nodes
#define TrStat_ans_max_depth trie_stats.answer_trie_max_depth
#define TrStat_ans_min_depth trie_stats.answer_trie_min_depth
#define SHOW_INFO(MESG, ARGS...) fprintf(stream, MESG, ##ARGS)
#define SHOW_TRIE(MESG, ARGS...) if (TrStat_show) fprintf(stream, MESG, ##ARGS)
#define TrStat_show trie_stats.show
#define TrStat_subgoals trie_stats.subgoals
#define TrStat_sg_abolished trie_stats.subgoals_abolished
#define TrStat_sg_abolish_operations trie_stats.subgoals_abolish_operations
#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes
#define TrStat_sg_linear_nodes trie_stats.subgoal_linear_nodes
#define TrStat_sg_max_depth trie_stats.subgoal_trie_max_depth
#define TrStat_sg_min_depth trie_stats.subgoal_trie_min_depth
#define TrStat_answers trie_stats.answers
#define TrStat_answers_yes trie_stats.answers_yes
#define TrStat_answers_no trie_stats.answers_no
#define TrStat_ans_pruned trie_stats.answers_pruned
#define TrStat_ans_nodes trie_stats.answer_trie_nodes
#define TrStat_ans_linear_nodes trie_stats.answer_linear_nodes
#define TrStat_ans_max_depth trie_stats.answer_trie_max_depth
#define TrStat_ans_min_depth trie_stats.answer_trie_min_depth
#define SHOW_INFO(MESG, ARGS...) fprintf(stream, MESG, ##ARGS)
#define SHOW_TRIE(MESG, ARGS...) if (TrStat_show) fprintf(stream, MESG, ##ARGS)
void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show) {
char str[1000];
@ -1077,13 +1098,16 @@ void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_
TrStat_show = show;
TrStat_subgoals = 0;
TrStat_subgoals_abolished = 0;
TrStat_sg_abolished = 0;
TrStat_sg_abolish_operations = 0;
TrStat_sg_nodes = 0;
TrStat_sg_linear_nodes = 0;
TrStat_sg_max_depth = -1;
TrStat_sg_min_depth = -1;
TrStat_answers = 0;
TrStat_answers_pruned = 0;
TrStat_answers_yes = 0;
TrStat_answers_no = 0;
TrStat_ans_pruned = 0;
TrStat_ans_nodes = 0;
TrStat_ans_linear_nodes = 0;
TrStat_ans_max_depth = -1;
@ -1095,8 +1119,10 @@ void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_
TrStat_sg_nodes++;
if (traverse_subgoal_trie(stream, sg_node, str, str_index, arity, 0)) {
SHOW_INFO("\n Subgoal Trie structure\n %ld subgoals", TrStat_subgoals);
if (TrStat_subgoals_abolished)
SHOW_INFO(" (including %ld abolished)", TrStat_subgoals_abolished);
if (TrStat_sg_abolished)
SHOW_INFO(" including %ld abolished", TrStat_sg_abolished);
if (TrStat_sg_abolish_operations)
SHOW_INFO(" (%ld abolish operations executed)", TrStat_sg_abolish_operations);
SHOW_INFO("\n %ld nodes (%ld%c reuse)\n %.2f average depth (%d min - %d max)",
TrStat_sg_nodes,
TrStat_sg_linear_nodes == 0 ? 0 : (TrStat_sg_linear_nodes - TrStat_sg_nodes + 1) * 100 / TrStat_sg_linear_nodes,
@ -1104,9 +1130,11 @@ void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_
TrStat_subgoals == 0 ? 0 : (float)TrStat_sg_linear_nodes / (float)TrStat_subgoals,
TrStat_sg_min_depth < 0 ? 0 : TrStat_sg_min_depth,
TrStat_sg_max_depth < 0 ? 0 : TrStat_sg_max_depth);
SHOW_INFO("\n Answer Trie Structure\n %ld answers", TrStat_answers);
if (TrStat_answers_pruned)
SHOW_INFO(" (including %ld pruned)", TrStat_answers_pruned);
SHOW_INFO("\n Answer Trie Structure\n %ld/%ld answers", TrStat_answers_yes, TrStat_answers);
if (TrStat_ans_pruned)
SHOW_INFO(" including %ld pruned", TrStat_ans_pruned);
if (TrStat_answers_no)
SHOW_INFO(" (%ld no answers)", TrStat_answers_no);
SHOW_INFO("\n %ld nodes (%ld%c reuse)\n %.2f average depth (%d min - %d max)",
TrStat_ans_nodes,
TrStat_ans_linear_nodes == 0 ? 0 : (TrStat_ans_linear_nodes - TrStat_ans_nodes + TrStat_subgoals) * 100 / TrStat_ans_linear_nodes,
@ -1132,9 +1160,10 @@ int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_
int new_arity[100];
if (arity[0] == 0) {
ans_node_ptr ans_node;
sg_fr_ptr sg_fr = (sg_fr_ptr)sg_node;
str[str_index] = 0;
TrStat_subgoals++;
TrStat_sg_abolish_operations += SgFr_abolish(sg_fr);
TrStat_sg_linear_nodes+= depth;
if (TrStat_sg_max_depth < 0) {
TrStat_sg_min_depth = TrStat_sg_max_depth = depth;
@ -1143,34 +1172,39 @@ int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_
} else if (depth > TrStat_sg_max_depth) {
TrStat_sg_max_depth = depth;
}
if (SgFr_state((sg_fr_ptr)sg_node) == ready) {
TrStat_subgoals_abolished++;
if (SgFr_state(sg_fr) == start) {
TrStat_sg_abolished++;
SHOW_TRIE("%s.\n ABOLISHED\n", str);
return TRUE;
}
if (SgFr_state((sg_fr_ptr)sg_node) == evaluating) {
if (SgFr_state(sg_fr) == evaluating) {
SHOW_INFO("%s. --> TRIE ERROR: subgoal not completed !!!\n", str);
return FALSE;
}
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
SHOW_TRIE("%s.\n", str);
ans_node = SgFr_answer_trie((sg_fr_ptr)sg_node);
TrStat_ans_nodes++;
if (IS_ANSWER_LEAF_NODE(ans_node)) {
SHOW_TRIE(" YES\n");
if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0;
TrStat_answers++;
} else if (TrNode_child(ans_node) == NULL) {
if (SgFr_first_answer(sg_fr) == NULL) {
SHOW_TRIE(" NO\n");
if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0;
TrStat_answers_no++;
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
SHOW_TRIE(" YES\n");
if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0;
TrStat_answers_yes++;
TrStat_answers++;
} else {
char answer_str[1000];
int answer_arity[1000];
answer_arity[0] = 0;
if (! traverse_answer_trie(stream, TrNode_child(ans_node), answer_str, 0, answer_arity, 0, 1))
if (! traverse_answer_trie(stream, TrNode_child(SgFr_answer_trie(sg_fr)), answer_str, 0, answer_arity, 0, 1))
return FALSE;
}
return TRUE;
@ -1301,7 +1335,7 @@ int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_
arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t));
break;
default:
abort_yaptab("unknown type tag in function traverse_subgoal_trie");
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (traverse_subgoal_trie)");
}
if (! traverse_subgoal_trie(stream, TrNode_child(sg_node), str, str_index, arity, depth + 1))
@ -1429,13 +1463,13 @@ int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str
arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t));
break;
default:
abort_yaptab("unknown type tag in function traverse_answer_trie");
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (traverse_answer_trie)");
}
if (! IS_ANSWER_LEAF_NODE(ans_node)) {
#ifdef TABLING_INNER_CUTS
if (! TrNode_child(ans_node)) {
TrStat_answers_pruned++;
TrStat_ans_pruned++;
return TRUE;
}
#endif /* TABLING_INNER_CUTS */