diff --git a/OPTYap/opt.config.h b/OPTYap/opt.config.h index cbec526a2..fa6eecf16 100644 --- a/OPTYap/opt.config.h +++ b/OPTYap/opt.config.h @@ -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 diff --git a/OPTYap/opt.init.c b/OPTYap/opt.init.c index 55b16fa3a..28bbdd32e 100644 --- a/OPTYap/opt.init.c +++ b/OPTYap/opt.init.c @@ -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; diff --git a/OPTYap/opt.macros.h b/OPTYap/opt.macros.h index 99d8c7c34..e4df738ae 100644 --- a/OPTYap/opt.macros.h +++ b/OPTYap/opt.macros.h @@ -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 +#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 *)); \ diff --git a/OPTYap/opt.memory.c b/OPTYap/opt.memory.c index 1e1b7551e..ad5ae8b1f 100644 --- a/OPTYap/opt.memory.c +++ b/OPTYap/opt.memory.c @@ -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 */ 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++) { diff --git a/OPTYap/opt.misc.c b/OPTYap/opt.misc.c index 1205ea086..d0312d243 100644 --- a/OPTYap/opt.misc.c +++ b/OPTYap/opt.misc.c @@ -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 */ diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index 45f5af565..cf928715c 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -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); diff --git a/OPTYap/opt.proto.h b/OPTYap/opt.proto.h index 4bbc747d9..1e159a515 100644 --- a/OPTYap/opt.proto.h +++ b/OPTYap/opt.proto.h @@ -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) diff --git a/OPTYap/or.cowengine.c b/OPTYap/or.cowengine.c index bfb0c9091..6c1c84bda 100644 --- a/OPTYap/or.cowengine.c +++ b/OPTYap/or.cowengine.c @@ -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; diff --git a/OPTYap/or.engine.c b/OPTYap/or.engine.c index f4239b1ad..2d188e645 100644 --- a/OPTYap/or.engine.c +++ b/OPTYap/or.engine.c @@ -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; diff --git a/OPTYap/or.sbaengine.c b/OPTYap/or.sbaengine.c index b3a14f8e2..16ecef4ee 100644 --- a/OPTYap/or.sbaengine.c +++ b/OPTYap/or.sbaengine.c @@ -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) { diff --git a/OPTYap/tab.insts.i b/OPTYap/tab.insts.i index e88d67b2f..1db9d0bcc 100644 --- a/OPTYap/tab.insts.i +++ b/OPTYap/tab.insts.i @@ -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 */ diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h index 74be1dc56..a5efa38c9 100644 --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -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; diff --git a/OPTYap/tab.structs.h b/OPTYap/tab.structs.h index 212d1b56d..d22465538 100644 --- a/OPTYap/tab.structs.h +++ b/OPTYap/tab.structs.h @@ -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. ** ------------------------------------------------------------------------------------------- */ diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index 8f524ff3f..cf7ff68b5 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -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 */