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

renaming some OPTYap files in order to have a more consistent name organization

Browse Source
This commit is contained in:
Ricardo Rocha 2010-04-19 02:34:08 +01:00
parent 73d210c991
commit c221c2ff85
23 changed files with 694 additions and 818 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
C/save.c
View File

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

20
H/Yap.h
View File

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

28
Makefile.in
View File

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

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

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

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

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

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

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

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

30
OPTYap/opt.init.c
View File

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

139
OPTYap/opt.macros.h
View File

@ -15,6 +15,8 @@
** Memory management **
************************************************************************/
extern int Yap_page_size;
#ifdef SHM_MEMORY_ALLOC_SCHEME
#include <sys/shm.h>
#define SHMMAX 0x2000000 /* 32 Mbytes: works fine with linux */
@ -22,8 +24,6 @@
/* #define SHMMAX 0x800000 - 8 Mbytes: shmget limit for Solaris (?) */
#endif /* SHM_MEMORY_ALLOC_SCHEME */
extern int Yap_page_size;
#if SIZEOF_INT_P == 4
#define ALIGN 3
#define ALIGNMASK 0xfffffffc
@ -43,48 +43,58 @@ extern int Yap_page_size;
#define UPDATE_STATS(STAT, VALUE) STAT += VALUE
#ifdef MALLOC_MEMORY_ALLOC_SCHEME /********************************************************************/
#ifdef MALLOC_MEMORY_ALLOC_SCHEME
/********************************************************************************************************
** MALLOC_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
if ((STR = (STR_TYPE *) malloc(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "ALLOC_BLOCK: malloc error")
#define FREE_BLOCK(STR) \
free(STR)
#else
/********************************************************************************************************
** ! MALLOC_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
{ char *block_ptr; \
if ((block_ptr = Yap_AllocCodeSpace(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'y'; \
else if ((block_ptr = (char *) malloc(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'm'; \
else \
Yap_Error(FATAL_ERROR, TermNil, "ALLOC_BLOCK: malloc error"); \
block_ptr += sizeof(CELL); \
STR = (STR_TYPE *) block_ptr; \
}
#define FREE_BLOCK(STR) \
{ char *block_ptr = (char *)(STR) - sizeof(CELL); \
if (block_ptr[0] == 'y') \
Yap_FreeCodeSpace(block_ptr); \
else \
free(block_ptr); \
}
#endif /************************************************************************************************/
#if defined(MALLOC_MEMORY_ALLOC_SCHEME) || defined(YAP_MEMORY_ALLOC_SCHEME)
/********************************************************************************************************
** MALLOC_MEMORY_ALLOC_SCHEME || YAP_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
if ((STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_STRUCT)")
ALLOC_BLOCK(STR, sizeof(STR_TYPE), STR_TYPE)
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE)
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
free(STR)
#elif YAP_MEMORY_ALLOC_SCHEME /************************************************************************/
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ char *ptr = Yap_AllocCodeSpace(sizeof(STR_TYPE) + sizeof(CELL)); \
if (ptr) { \
*ptr = 'y'; \
ptr += sizeof(CELL); \
STR = (STR_TYPE *)ptr; \
} else { \
ptr = (char *)malloc(sizeof(STR_TYPE) + sizeof(CELL)); \
if (ptr) { \
*ptr = 'm'; \
ptr += sizeof(CELL); \
STR = (STR_TYPE *)ptr; \
} else { \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_STRUCT)"); \
STR = NULL; \
} \
} \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
}
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE)
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ char *ptr = (char *)(STR) - sizeof(CELL); \
if (ptr[0] == 'y') { \
Yap_FreeCodeSpace(ptr); \
} else \
free(ptr); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
}
#elif SHM_MEMORY_ALLOC_SCHEME /************************************************************************/
FREE_BLOCK(STR)
#elif SHM_MEMORY_ALLOC_SCHEME
#ifdef LIMIT_TABLING
/********************************************************************************************************
** SHM_MEMORY_ALLOC_SCHEME && LIMIT_TABLING **
********************************************************************************************************/
#define INIT_PAGE(PG_HD, STR_PAGES, STR_TYPE) \
{ int i; \
STR_TYPE *aux_str; \
@ -220,6 +230,9 @@ extern int Yap_page_size;
} \
LOCAL_next_free_ans_node = STRUCT_NEXT(STR)
#else
/********************************************************************************************************
** SHM_MEMORY_ALLOC_SCHEME && !LIMIT_TABLING **
********************************************************************************************************/
#define ALLOC_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
@ -313,7 +326,9 @@ extern int Yap_page_size;
} \
LOCAL_next_free_ans_node = STRUCT_NEXT(STR)
#endif /* LIMIT_TABLING */
/********************************************************************************************************
** SHM_MEMORY_ALLOC_SCHEME **
********************************************************************************************************/
#define FREE_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), -1); \
@ -350,26 +365,12 @@ extern int Yap_page_size;
}
#endif /************************************************************************************************/
#ifdef YAPOR
#define ALLOC_BLOCK(BLOCK, SIZE) \
if ((BLOCK = (void *) Yap_AllocCodeSpace(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "Yap_AllocCodeSpace error (ALLOC_BLOCK)")
#define FREE_BLOCK(BLOCK) \
Yap_FreeCodeSpace((char *) (BLOCK))
#else /* TABLING */
#define ALLOC_BLOCK(BLOCK, SIZE) \
if ((BLOCK = malloc(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_BLOCK)")
#define FREE_BLOCK(BLOCK) \
free(BLOCK)
#endif /* YAPOR - TABLING */
#define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **ptr; \
ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \
BUCKET_PTR = (void *) ptr; \
{ int i; void **bucket_ptr; \
ALLOC_BLOCK(bucket_ptr, NUM_BUCKETS * sizeof(void *), void *); \
BUCKET_PTR = (void *) bucket_ptr; \
for (i = NUM_BUCKETS; i != 0; i--) \
*ptr++ = NULL; \
*bucket_ptr++ = NULL; \
}
#define FREE_HASH_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR)
@ -391,22 +392,9 @@ extern int Yap_page_size;
#define ALLOC_TABLE_ENTRY(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_tab_ent, struct table_entry)
#define FREE_TABLE_ENTRY(STR) FREE_STRUCT(STR, GLOBAL_PAGES_tab_ent, struct table_entry)
#define ALLOC_GLOBAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define FREE_GLOBAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define ALLOC_SUBGOAL_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_fr, struct subgoal_frame)
#define FREE_SUBGOAL_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_fr, struct subgoal_frame)
#ifdef YAPOR
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_NEXT_FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#else /* TABLING */
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#endif /* YAPOR - TABLING */
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#define ALLOC_DEPENDENCY_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_dep_fr, struct dependency_frame)
#define FREE_DEPENDENCY_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_dep_fr, struct dependency_frame)
@ -414,6 +402,19 @@ extern int Yap_page_size;
#define FREE_SUSPENSION_FRAME(STR) FREE_BLOCK(SuspFr_global_start(STR)); \
FREE_STRUCT(STR, GLOBAL_PAGES_susp_fr, struct suspension_frame)
#define ALLOC_GLOBAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define FREE_GLOBAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_gt_node, struct global_trie_node)
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#ifdef YAPOR
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_NEXT_FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#else /* TABLING */
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#endif /* YAPOR - TABLING */
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#define ALLOC_GLOBAL_TRIE_HASH(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_gt_hash, struct global_trie_hash)
#define FREE_GLOBAL_TRIE_HASH(STR) FREE_STRUCT(STR, GLOBAL_PAGES_gt_hash, struct global_trie_hash)

56
OPTYap/opt.misc.c
View File

@ -1,56 +0,0 @@
/************************************************************************
** **
** The YapTab/YapOr/OPTYap systems **
** **
** YapTab extends the Yap Prolog engine to support sequential tabling **
** YapOr extends the Yap Prolog engine to support or-parallelism **
** OPTYap extends the Yap Prolog engine to support or-parallel tabling **
** **
** **
** Yap Prolog was developed at University of Porto, Portugal **
** **
************************************************************************/
/***********************
** Includes **
***********************/
#include "Yap.h"
#if defined(YAPOR) || defined(TABLING)
#if HAVE_UNISTD_H
#include <unistd.h>
#endif /* HAVE_UNISTD_H */
#include "Yatom.h"
#include "yapio.h"
/************************************************
** Global variables are defined here **
************************************************/
#if defined(YAPOR) && ! defined(THREADS)
struct worker WORKER;
#endif /* YAPOR && ! THREADS */
/*******************************
** Global functions **
*******************************/
void itos(int i, char *s) {
int n,r,j;
n = 10;
while (n <= i) n *= 10;
j = 0;
while (n > 1) {
n = n / 10;
r = i / n;
i = i - r * n;
s[j++] = r + '0';
}
s[j] = 0;
return;
}
#endif /* YAPOR || TABLING */

31
OPTYap/opt.proto.h
View File

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

6
OPTYap/opt.structs.h
View File

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

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

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

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

@ -11,18 +11,18 @@
** **
************************************************************************/
/************************************
** Includes & Prototypes **
************************************/
/***********************
** Includes **
***********************/
#include "Yap.h"
#if defined(TABLING) && defined(YAPOR)
#ifdef TABLING
#include "Yatom.h"
#include "YapHeap.h"
#include "tab.macros.h"
#ifdef YAPOR
#include "or.macros.h"
static void complete_suspension_branch(susp_fr_ptr, choiceptr, or_fr_ptr *, dep_fr_ptr *);
#endif /* YAPOR */
@ -30,6 +30,7 @@ static void complete_suspension_branch(susp_fr_ptr, choiceptr, or_fr_ptr *, dep_
** Local functions **
******************************/
#ifdef YAPOR
static void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or_fr_ptr *chain_or_fr, dep_fr_ptr *chain_dep_fr) {
or_fr_ptr aux_or_fr;
sg_fr_ptr aux_sg_fr;
@ -94,6 +95,7 @@ static void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or
return;
}
#endif /* YAPOR */
@ -101,6 +103,44 @@ static void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or
** Global functions **
*******************************/
void private_completion(sg_fr_ptr sg_fr) {
/* complete subgoals */
#ifdef LIMIT_TABLING
sg_fr_ptr aux_sg_fr;
while (LOCAL_top_sg_fr != sg_fr) {
aux_sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(aux_sg_fr);
mark_as_completed(aux_sg_fr);
insert_into_global_sg_fr_list(aux_sg_fr);
}
aux_sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(aux_sg_fr);
mark_as_completed(aux_sg_fr);
insert_into_global_sg_fr_list(aux_sg_fr);
#else
while (LOCAL_top_sg_fr != sg_fr) {
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
#endif /* LIMIT_TABLING */
/* release dependency frames */
while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) { /* never equal if batched scheduling */
dep_fr_ptr dep_fr = DepFr_next(LOCAL_top_dep_fr);
FREE_DEPENDENCY_FRAME(LOCAL_top_dep_fr);
LOCAL_top_dep_fr = dep_fr;
}
/* adjust freeze registers */
adjust_freeze_registers();
return;
}
#ifdef YAPOR
void public_completion(void) {
dep_fr_ptr chain_dep_fr, next_dep_fr;
or_fr_ptr chain_or_fr, top_or_fr, next_or_fr;
@ -410,4 +450,5 @@ void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr) {
return;
}
#endif /* TABLING && YAPOR */
#endif /* YAPOR */
#endif /* TABLING */

247
OPTYap/tab.macros.h
View File

@ -18,21 +18,19 @@
#include <stdlib.h>
#if HAVE_STRING_H
#include <string.h>
#endif
#endif /* HAVE_STRING_H */
#include "opt.mavar.h"
static inline CELL *expand_auxiliary_stack(CELL *);
static inline choiceptr freeze_current_cp(void);
static inline void resume_frozen_cp(choiceptr);
static inline void abolish_all_frozen_cps(void);
static inline void adjust_freeze_registers(void);
static inline void mark_as_completed(sg_fr_ptr);
static inline void unbind_variables(tr_fr_ptr, tr_fr_ptr);
static inline void rebind_variables(tr_fr_ptr, tr_fr_ptr);
static inline void restore_bindings(tr_fr_ptr, tr_fr_ptr);
static inline CELL *expand_auxiliary_stack(CELL *);
static inline void abolish_incomplete_subgoals(choiceptr);
static inline void free_subgoal_trie_hash_chain(sg_hash_ptr);
static inline void free_answer_trie_hash_chain(ans_hash_ptr);
static inline choiceptr freeze_current_cp(void);
static inline void resume_frozen_cp(choiceptr);
static inline void abolish_all_frozen_cps(void);
#ifdef YAPOR
static inline void pruning_over_tabling_data_structures(void);
static inline void collect_suspension_frames(or_fr_ptr);
@ -85,9 +83,9 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
/*********************
** Macros **
*********************/
/******************************
** Tabling defines **
******************************/
#define SHOW_MODE_STRUCTURE 0
#define SHOW_MODE_STATISTICS 1
@ -166,6 +164,12 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
#define EXPAND_AUX_STACK(STACK) STACK = expand_auxiliary_stack(STACK)
#endif /* YAPOR */
/*************************************
** Data structures macros **
*************************************/
#ifdef YAPOR
#define frame_with_suspensions_not_collected(OR_FR) \
(OrFr_nearest_suspnode(OR_FR) == NULL)
@ -413,24 +417,36 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
** Inline funcions **
******************************/
static inline
CELL *expand_auxiliary_stack(CELL *stack) {
void *old_top = Yap_TrailTop;
INFORMATION_MESSAGE("Expanding trail in 64 Kbytes");
if (! Yap_growtrail(64 * 1024L, TRUE)) { /* TRUE means 'contiguous_only' */
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)");
return NULL;
} else {
UInt diff = (void *)Yap_TrailTop - old_top;
CELL *new_stack = (CELL *)((void *)stack + diff);
memmove((void *)new_stack, (void *)stack, old_top - (void *)stack);
return new_stack;
}
static inline choiceptr freeze_current_cp(void) {
choiceptr freeze_cp = B;
B_FZ = freeze_cp;
H_FZ = freeze_cp->cp_h;
TR_FZ = freeze_cp->cp_tr;
B = B->cp_b;
HB = B->cp_h;
return freeze_cp;
}
static inline
void adjust_freeze_registers(void) {
static inline void resume_frozen_cp(choiceptr frozen_cp) {
restore_bindings(TR, frozen_cp->cp_tr);
B = frozen_cp;
TR = TR_FZ;
TRAIL_LINK(B->cp_tr);
return;
}
static inline void abolish_all_frozen_cps(void) {
B_FZ = (choiceptr) Yap_LocalBase;
H_FZ = (CELL *) Yap_GlobalBase;
TR_FZ = (tr_fr_ptr) Yap_TrailBase;
return;
}
static inline void adjust_freeze_registers(void) {
B_FZ = DepFr_cons_cp(LOCAL_top_dep_fr);
H_FZ = B_FZ->cp_h;
TR_FZ = B_FZ->cp_tr;
@ -438,8 +454,7 @@ void adjust_freeze_registers(void) {
}
static inline
void mark_as_completed(sg_fr_ptr sg_fr) {
static inline void mark_as_completed(sg_fr_ptr sg_fr) {
LOCK(SgFr_lock(sg_fr));
SgFr_state(sg_fr) = complete;
UNLOCK(SgFr_lock(sg_fr));
@ -447,8 +462,7 @@ void mark_as_completed(sg_fr_ptr sg_fr) {
}
static inline
void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
static inline void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
TABLING_ERROR_CHECKING(unbind_variables, unbind_tr < end_tr);
/* unbind loop */
while (unbind_tr != end_tr) {
@ -478,8 +492,7 @@ void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
}
static inline
void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
static inline void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
TABLING_ERROR_CHECKING(rebind_variables, rebind_tr < end_tr);
/* rebind loop */
Yap_NEW_MAHASH((ma_h_inner_struct *)H);
@ -512,8 +525,7 @@ void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
}
static inline
void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
CELL ref;
tr_fr_ptr end_tr;
@ -586,8 +598,22 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
}
static inline
void abolish_incomplete_subgoals(choiceptr prune_cp) {
static inline CELL *expand_auxiliary_stack(CELL *stack) {
void *old_top = Yap_TrailTop;
INFORMATION_MESSAGE("Expanding trail in 64 Kbytes");
if (! Yap_growtrail(64 * 1024L, TRUE)) { /* TRUE means 'contiguous_only' */
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)");
return NULL;
} else {
UInt diff = (void *)Yap_TrailTop - old_top;
CELL *new_stack = (CELL *)((void *)stack + diff);
memmove((void *)new_stack, (void *)stack, old_top - (void *)stack);
return new_stack;
}
}
static inline void abolish_incomplete_subgoals(choiceptr prune_cp) {
#ifdef YAPOR
if (EQUAL_OR_YOUNGER_CP(GetOrFr_node(LOCAL_top_susp_or_fr), prune_cp))
pruning_over_tabling_data_structures();
@ -653,134 +679,14 @@ void abolish_incomplete_subgoals(choiceptr prune_cp) {
}
static inline
void free_subgoal_trie_hash_chain(sg_hash_ptr hash) {
while (hash) {
sg_node_ptr chain_node, *bucket, *last_bucket;
sg_hash_ptr next_hash;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(TrNode_parent(chain_node)) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_SUBGOAL_TRIE_HASH(hash);
hash = next_hash;
}
return;
}
static inline
void free_answer_trie_hash_chain(ans_hash_ptr hash) {
while (hash) {
ans_node_ptr chain_node, *bucket, *last_bucket;
ans_hash_ptr next_hash;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(UNTAG_ANSWER_LEAF_NODE(TrNode_parent(chain_node))) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_ANSWER_TRIE_HASH(hash);
hash = next_hash;
}
return;
}
/*
static inline
choiceptr create_cp_and_freeze(void) {
choiceptr freeze_cp;
// initialize and store freeze choice point
// freeze_cp = (NORM_CP(YENV) - 1);
freeze_cp = (NORM_CP(YENV) - 2);
HBREG = H;
store_yaam_reg_cpdepth(freeze_cp);
freeze_cp->cp_tr = TR;
freeze_cp->cp_ap = (yamop *)(TRUSTFAILCODE);
freeze_cp->cp_h = H;
freeze_cp->cp_b = B;
freeze_cp->cp_env = ENV;
freeze_cp->cp_cp = CPREG;
// set_cut((CELL *)freeze_cp, B);
B = freeze_cp;
SET_BB(B);
// adjust freeze registers
B_FZ = freeze_cp;
H_FZ = H;
TR_FZ = TR;
return freeze_cp;
}
*/
static inline
choiceptr freeze_current_cp(void) {
choiceptr freeze_cp = B;
B_FZ = freeze_cp;
H_FZ = freeze_cp->cp_h;
TR_FZ = freeze_cp->cp_tr;
B = B->cp_b;
HB = B->cp_h;
return freeze_cp;
}
static inline
void resume_frozen_cp(choiceptr frozen_cp) {
restore_bindings(TR, frozen_cp->cp_tr);
B = frozen_cp;
TR = TR_FZ;
TRAIL_LINK(B->cp_tr);
return;
}
static inline
void abolish_all_frozen_cps(void) {
B_FZ = (choiceptr) Yap_LocalBase;
H_FZ = (CELL *) Yap_GlobalBase;
TR_FZ = (tr_fr_ptr) Yap_TrailBase;
return;
}
#ifdef YAPOR
static inline
void pruning_over_tabling_data_structures(void) {
static inline void pruning_over_tabling_data_structures(void) {
Yap_Error(INTERNAL_ERROR, TermNil, "pruning over tabling data structures");
return;
}
static inline
void collect_suspension_frames(or_fr_ptr or_fr) {
static inline void collect_suspension_frames(or_fr_ptr or_fr) {
int depth;
or_fr_ptr *susp_ptr;
@ -838,8 +744,7 @@ susp_fr_ptr suspension_frame_to_resume(or_fr_ptr susp_or_fr) {
#ifdef TABLING_INNER_CUTS
static inline
void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr gen_cp, int ltt) {
static inline void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr gen_cp, int ltt) {
tg_sol_fr_ptr tg_sol_fr, *solution_ptr, next, ltt_next;
tg_ans_fr_ptr tg_ans_fr;
@ -892,8 +797,7 @@ void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr ge
}
static inline
tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr or_frame, tg_sol_fr_ptr new_solution, int ltt) {
static inline tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr or_frame, tg_sol_fr_ptr new_solution, int ltt) {
tg_sol_fr_ptr *old_solution_ptr, next_new_solution;
choiceptr node, gen_cp;
@ -941,8 +845,7 @@ tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr or_frame, tg_sol_fr_ptr new_solutio
}
static inline
void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
static inline void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
tg_ans_fr_ptr valid_answers, free_answer;
tg_sol_fr_ptr ltt_valid_solutions, free_solution;
ans_node_ptr first_answer, last_answer, ans_node;
@ -1011,8 +914,7 @@ void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
}
static inline
void CUT_join_tg_solutions(tg_sol_fr_ptr *old_solution_ptr, tg_sol_fr_ptr new_solution) {
static inline void CUT_join_tg_solutions(tg_sol_fr_ptr *old_solution_ptr, tg_sol_fr_ptr new_solution) {
tg_sol_fr_ptr next_old_solution, next_new_solution;
choiceptr gen_cp;
@ -1059,8 +961,7 @@ void CUT_join_tg_solutions(tg_sol_fr_ptr *old_solution_ptr, tg_sol_fr_ptr new_so
}
static inline
void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr join_solution) {
static inline void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr join_solution) {
tg_sol_fr_ptr next_solution;
while ((next_solution = TgSolFr_ltt_next(join_solution))) {
@ -1073,8 +974,7 @@ void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr join_solution) {
}
static inline
void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr join_solution) {
static inline void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr join_solution) {
do {
CUT_join_solution_frame_tg_answers(join_solution);
join_solution = TgSolFr_next(join_solution);
@ -1083,8 +983,7 @@ void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr join_solution) {
}
static inline
void CUT_free_tg_solution_frame(tg_sol_fr_ptr solution) {
static inline void CUT_free_tg_solution_frame(tg_sol_fr_ptr solution) {
tg_ans_fr_ptr current_answer, next_answer;
current_answer = TgSolFr_first(solution);
@ -1098,8 +997,7 @@ void CUT_free_tg_solution_frame(tg_sol_fr_ptr solution) {
}
static inline
void CUT_free_tg_solution_frames(tg_sol_fr_ptr current_solution) {
static inline void CUT_free_tg_solution_frames(tg_sol_fr_ptr current_solution) {
tg_sol_fr_ptr ltt_solution, next_solution;
while (current_solution) {
@ -1117,8 +1015,7 @@ void CUT_free_tg_solution_frames(tg_sol_fr_ptr current_solution) {
}
static inline
tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr solutions, int ltt) {
static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr solutions, int ltt) {
tg_sol_fr_ptr ltt_next_solution, return_solution;
if (! solutions) return NULL;

19
OPTYap/tab.structs.h
View File

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

807
OPTYap/tab.tries.c
View File

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

16
VC/include/Yap.h
View File

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

22
VC/yapdll.mak
View File

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