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

TABLING: new predicates 'tabling_statistics' and 'abolish_all_tables'.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1343 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc 2005-07-11 19:17:32 +00:00
parent 3a93e0e079
commit 5ef65b053e
10 changed files with 1059 additions and 723 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
OPTYap/opt.config.h
View File

@ -5,17 +5,17 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.config.h File: opt.config.h
version: $Id: opt.config.h,v 1.6 2005-06-03 18:28:11 ricroc Exp $ version: $Id: opt.config.h,v 1.7 2005-07-11 19:17:24 ricroc Exp $
**********************************************************************/ **********************************************************************/
/* ---------------------------------- ** /* ---------------------------------------------------------------- **
** Configuration Parameters ** ** Configuration Parameters **
** ---------------------------------- */ ** ---------------------------------------------------------------- */
/* --------------- ** /* ----------------------- **
** sizes ** ** default sizes **
** --------------- */ ** ----------------------- */
#define MAX_LENGTH_ANSWER 500 #define MAX_LENGTH_ANSWER 500
#define MAX_DEPTH 1000 #define MAX_DEPTH 1000
#define MAX_BEST_TIMES 21 #define MAX_BEST_TIMES 21
@ -23,20 +23,27 @@
#define TABLE_LOCK_BUCKETS 512 #define TABLE_LOCK_BUCKETS 512
#define TG_ANSWER_SLOTS 20 #define TG_ANSWER_SLOTS 20
/* ---------------------------- ** /* ----------------------------------------- **
** memory (define one) ** ** memory alloc scheme (define one) **
** ---------------------------- */ ** ----------------------------------------- */
#define SHM_MEMORY_ALLOC_SCHEME 1
/* #define YAP_MEMORY_ALLOC_SCHEME 1 */
/* #define MALLOC_MEMORY_ALLOC_SCHEME 1 */
/* ------------------------------------------- **
** memory mapping scheme (define one) **
** ------------------------------------------- */
#define MMAP_MEMORY_MAPPING_SCHEME 1 #define MMAP_MEMORY_MAPPING_SCHEME 1
/* #define SHM_MEMORY_MAPPING_SCHEME 1 */ /* #define SHM_MEMORY_MAPPING_SCHEME 1 */
/* ------------------------------------- ** /* ------------------------------------------ **
** freezing trail (define one) ** ** trail freeze scheme (define one) **
** ------------------------------------- */ ** ------------------------------------------ */
#define BFZ_TRAIL_SCHEME 1 #define BFZ_TRAIL_SCHEME 1
/* #define BBREG_TRAIL_SCHEME 1 */ /* #define BBREG_TRAIL_SCHEME 1 */
/* ------------------------------------------------------------------ ** /* ------------------------------------------------------------------ **
** locking tries (define one) ** ** tries locking scheme (define one) **
** ------------------------------------------------------------------ ** ** ------------------------------------------------------------------ **
** The TABLE_LOCK_AT_ENTRY_LEVEL scheme locks the access to the table ** ** The TABLE_LOCK_AT_ENTRY_LEVEL scheme locks the access to the table **
** space in the entry data structure. It restricts the number of lock ** ** space in the entry data structure. It restricts the number of lock **
@ -56,28 +63,42 @@
/* #define TABLE_LOCK_AT_NODE_LEVEL 1 */ /* #define TABLE_LOCK_AT_NODE_LEVEL 1 */
/* #define ALLOC_BEFORE_CHECK 1 */ /* #define ALLOC_BEFORE_CHECK 1 */
/* ------------------------ ** /* --------------------------------------- **
** cuts (optional) ** ** support inner cuts? (optional) **
** ------------------------ */ ** --------------------------------------- */
#define TABLING_INNER_CUTS 1 #define TABLING_INNER_CUTS 1
/* ------------------------------ ** /* -------------------------------------------------- **
** suspension (optional) ** ** use timestamps for suspension? (optional) **
** ------------------------------ */ ** -------------------------------------------------- */
#define TIMESTAMP_CHECK 1 #define TIMESTAMP_CHECK 1
/* ----------------------------- ** /* ------------------------------------------ **
** debugging (optional) ** ** enable error checking? (optional) **
** ----------------------------- */ ** ------------------------------------------ */
/* #define STATISTICS 1 */
/* #define YAPOR_ERRORS 1 */ /* #define YAPOR_ERRORS 1 */
/* #define TABLING_ERRORS 1 */ /* #define TABLING_ERRORS 1 */
/* -------------------------- ** /* -------------------------------------------------------- **
** Parameter Checks ** ** Parameter Checks **
** -------------------------- */ ** -------------------------------------------------------- */
#if !defined(SHM_MEMORY_ALLOC_SCHEME) && !defined(MALLOC_MEMORY_ALLOC_SCHEME) && !defined(YAP_MEMORY_ALLOC_SCHEME)
#error Define a memory alloc scheme
#endif /* !SHM_MEMORY_ALLOC_SCHEME && !MALLOC_MEMORY_ALLOC_SCHEME && !YAP_MEMORY_ALLOC_SCHEME */
#if defined(SHM_MEMORY_ALLOC_SCHEME)
#if defined(MALLOC_MEMORY_ALLOC_SCHEME) || defined(YAP_MEMORY_ALLOC_SCHEME)
#error Do not define multiple memory alloc schemes
#endif /* MALLOC_MEMORY_ALLOC_SCHEME || YAP_MEMORY_ALLOC_SCHEME */
#endif /* SHM_MEMORY_ALLOC_SCHEME */
#if defined(MALLOC_MEMORY_ALLOC_SCHEME) && defined(YAP_MEMORY_ALLOC_SCHEME)
#error Do not define multiple memory alloc schemes
#endif /* MALLOC_MEMORY_ALLOC_SCHEME && YAP_MEMORY_ALLOC_SCHEME */
#if defined(YAPOR) && defined(MALLOC_MEMORY_ALLOC_SCHEME)
#error YAPOR is incompatible with MALLOC_MEMORY_ALLOC_SCHEME
#endif /* YAPOR && TABLING && (MALLOC_MEMORY_ALLOC_SCHEME || YAP_MEMORY_ALLOC_SCHEME) */
#ifdef YAPOR #ifdef YAPOR
#ifdef i386 /* For i386 machines we use shared memory segments */ #ifdef i386 /* For i386 machines we use shared memory segments */

17
OPTYap/opt.init.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.init.c File: opt.init.c
version: $Id: opt.init.c,v 1.8 2005-07-06 19:33:54 ricroc Exp $ version: $Id: opt.init.c,v 1.9 2005-07-11 19:17:26 ricroc Exp $
**********************************************************************/ **********************************************************************/
@ -48,21 +48,12 @@ ma_h_inner_struct *ma_h_top;
#define STRUCTS_PER_PAGE(STR_TYPE) ((Yap_page_size - STRUCT_SIZE(struct page_header)) / STRUCT_SIZE(STR_TYPE)) #define STRUCTS_PER_PAGE(STR_TYPE) ((Yap_page_size - STRUCT_SIZE(struct page_header)) / STRUCT_SIZE(STR_TYPE))
#ifdef STATISTICS
#define INIT_PAGE_STATISTICS(PG) \
Pg_pg_alloc(PG) = 0; \
Pg_str_alloc(PG) = 0; \
Pg_str_in_use(PG) = 0; \
Pg_requests(PG) = 0
#else
#define INIT_PAGE_STATISTICS(PG)
#endif /* STATISTICS */
#define INIT_PAGES(PG, STR_TYPE) \ #define INIT_PAGES(PG, STR_TYPE) \
INIT_LOCK(Pg_lock(PG)); \ INIT_LOCK(Pg_lock(PG)); \
Pg_pg_alloc(PG) = 0; \
Pg_str_in_use(PG) = 0; \
Pg_str_per_pg(PG) = STRUCTS_PER_PAGE(STR_TYPE); \ Pg_str_per_pg(PG) = STRUCTS_PER_PAGE(STR_TYPE); \
Pg_free_pg(PG) = NULL; \ Pg_free_pg(PG) = NULL
INIT_PAGE_STATISTICS(PG)

326
OPTYap/opt.macros.h
View File

@ -5,10 +5,20 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.macros.h File: opt.macros.h
version: $Id: opt.macros.h,v 1.6 2005-05-31 08:24:24 ricroc Exp $ version: $Id: opt.macros.h,v 1.7 2005-07-11 19:17:27 ricroc Exp $
**********************************************************************/ **********************************************************************/
/* ------------------------------ **
** Includes and defines **
** ------------------------------ */
#include <sys/shm.h>
#define SHMMAX 0x2000000 /* works fine with linux */
/* --------------------------- ** /* --------------------------- **
** Memory management ** ** Memory management **
** --------------------------- */ ** --------------------------- */
@ -38,174 +48,180 @@ extern int Yap_page_size;
#ifdef STATISTICS
#define UPDATE_STATS(STAT, VALUE) STAT += VALUE #define UPDATE_STATS(STAT, VALUE) STAT += VALUE
#else
#define UPDATE_STATS(STAT, VALUE)
#endif /* STATISTICS */
#ifdef MALLOC_MEMORY_ALLOC_SCHEME /* --------------------------------------------- */
#define ALLOC_BLOCK(BLOCK, SIZE) \
#define ALLOC_BLOCK(BLOCK, SIZE) \ if ((BLOCK = malloc(SIZE)) == NULL) \
if ((BLOCK = malloc(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_BLOCK)") Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_BLOCK)")
/* BLOCK = (void *) Yap_AllocCodeSpace(SIZE) */ #define FREE_BLOCK(BLOCK) \
#define FREE_BLOCK(BLOCK) \
free(BLOCK) free(BLOCK)
/* Yap_FreeCodeSpace((char *) (BLOCK)) */ #define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
#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) \ if ((STR = (STR_TYPE *)malloc(sizeof(STR_TYPE))) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_STRUCT)") Yap_Error(FATAL_ERROR, TermNil, "malloc error (ALLOC_STRUCT)")
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \ #define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE)
#define FREE_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) free(STR)
/* #elif YAP_MEMORY_ALLOC_SCHEME /* ----------------------------------------------- */
#include <sys/shm.h> #define ALLOC_BLOCK(BLOCK, SIZE) \
#define SHMMAX 0x2000000 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))
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
if ((STR = (STR_TYPE *) Yap_AllocCodeSpace(sizeof(STR_TYPE))) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "Yap_AllocCodeSpace 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) \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
Yap_FreeCodeSpace((char *) (STR))
#elif SHM_MEMORY_ALLOC_SCHEME /* ------------------------------------------------ */
#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))
#define ALLOC_PAGE(PG_HD) \ #define ALLOC_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \ LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \ UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \ if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \ int i, shmid; \
int i, shmid; \ pg_hd_ptr pg_hd, aux_pg_hd; \
pg_hd_ptr pg_hd, aux_pg_hd; \ if ((shmid = shmget(IPC_PRIVATE, SHMMAX, SHM_R|SHM_W)) == -1) \
if ((shmid = shmget(IPC_PRIVATE, SHMMAX, SHM_R|SHM_W)) == -1) \ Yap_Error(FATAL_ERROR, TermNil, "shmget error (ALLOC_PAGE)"); \
Yap_Error(FATAL_ERROR, TermNil, "shmget error (ALLOC_PAGE)"); \ if ((pg_hd = (pg_hd_ptr) shmat(shmid, NULL, 0)) == (void *) -1) \
if ((pg_hd = (pg_hd_ptr) shmat(shmid, NULL, 0)) == (void *) -1) \ Yap_Error(FATAL_ERROR, TermNil, "shmat error (ALLOC_PAGE)"); \
Yap_Error(FATAL_ERROR, TermNil, "shmat error (ALLOC_PAGE)"); \ if (shmctl(shmid, IPC_RMID, 0) != 0) \
if (shmctl(shmid, IPC_RMID, 0) != 0) \ Yap_Error(FATAL_ERROR, TermNil, "shmctl error (ALLOC_PAGE)"); \
Yap_Error(FATAL_ERROR, TermNil, "shmctl error (ALLOC_PAGE)"); \ Pg_free_pg(GLOBAL_PAGES_void) = pg_hd; \
Pg_free_pg(GLOBAL_PAGES_void) = pg_hd; \ for (i = 1; i < SHMMAX / Yap_page_size; i++) { \
for (i = 1; i < SHMMAX / Yap_page_size; i++) { \ aux_pg_hd = (pg_hd_ptr)(((void *)pg_hd) + Yap_page_size); \
aux_pg_hd = (pg_hd_ptr)(((void *)pg_hd) + Yap_page_size); \ PgHd_next(pg_hd) = aux_pg_hd; \
PgHd_next(pg_hd) = aux_pg_hd; \ pg_hd = aux_pg_hd; \
pg_hd = aux_pg_hd; \ } \
} \ PgHd_next(pg_hd) = NULL; \
PgHd_next(pg_hd) = NULL; \ UPDATE_STATS(Pg_pg_alloc(GLOBAL_PAGES_void), SHMMAX / Yap_page_size); \
UPDATE_STATS(Pg_str_alloc(GLOBAL_PAGES_void), SHMMAX / Yap_page_size); \ } \
} \ PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \
PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \ Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \
Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \
UNLOCK(Pg_lock(GLOBAL_PAGES_void)) UNLOCK(Pg_lock(GLOBAL_PAGES_void))
#define FREE_PAGE(PG_HD) \ #define FREE_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \ LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \ UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), -1); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), -1); \ PgHd_next(PG_HD) = Pg_free_pg(GLOBAL_PAGES_void); \
PgHd_next(PG_HD) = Pg_free_pg(GLOBAL_PAGES_void); \ Pg_free_pg(GLOBAL_PAGES_void) = PG_HD; \
Pg_free_pg(GLOBAL_PAGES_void) = PG_HD; \
UNLOCK(Pg_lock(GLOBAL_PAGES_void)) UNLOCK(Pg_lock(GLOBAL_PAGES_void))
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \ #define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ pg_hd_ptr pg_hd; \ { pg_hd_ptr pg_hd; \
LOCK(Pg_lock(STR_PAGES)); \ LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_requests(STR_PAGES), 1); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \ if (Pg_free_pg(STR_PAGES)) { \
if (Pg_free_pg(STR_PAGES)) { \ pg_hd = Pg_free_pg(STR_PAGES); \
pg_hd = Pg_free_pg(STR_PAGES); \ PgHd_str_in_use(pg_hd)++; \
PgHd_str_in_use(pg_hd)++; \ STR = (STR_TYPE *) PgHd_free_str(pg_hd); \
STR = (STR_TYPE *) PgHd_free_str(pg_hd); \ if ((PgHd_free_str(pg_hd) = (void *) STRUCT_NEXT(STR)) == NULL) \
if ((PgHd_free_str(pg_hd) = (void *) STRUCT_NEXT(STR)) == NULL) \ if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \
if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \ PgHd_previous(PgHd_next(pg_hd)) = NULL; \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \ UNLOCK(Pg_lock(STR_PAGES)); \
UNLOCK(Pg_lock(STR_PAGES)); \ } else { \
} else { \ int i; \
int i; \ UPDATE_STATS(Pg_pg_alloc(STR_PAGES), 1); \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), 1); \ UNLOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_str_alloc(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \ ALLOC_PAGE(pg_hd); \
UNLOCK(Pg_lock(STR_PAGES)); \ PgHd_str_in_use(pg_hd) = 1; \
ALLOC_PAGE(pg_hd); \ PgHd_previous(pg_hd) = NULL; \
PgHd_str_in_use(pg_hd) = 1; \ STR = (STR_TYPE *) (pg_hd + 1); \
PgHd_previous(pg_hd) = NULL; \ PgHd_free_str(pg_hd) = (void *) ++STR; \
STR = (STR_TYPE *) (pg_hd + 1); \ for (i = Pg_str_per_pg(STR_PAGES); i != 2; i--) { \
PgHd_free_str(pg_hd) = (void *) ++STR; \ STRUCT_NEXT(STR) = STR + 1; \
for (i = Pg_str_per_pg(STR_PAGES); i != 2; i--) { \ STR++; \
STRUCT_NEXT(STR) = STR + 1; \ } \
STR++; \ STRUCT_NEXT(STR) = NULL; \
} \ STR = (STR_TYPE *) (pg_hd + 1); \
STRUCT_NEXT(STR) = NULL; \ LOCK(Pg_lock(STR_PAGES)); \
STR = (STR_TYPE *) (pg_hd + 1); \ if ((PgHd_next(pg_hd) = Pg_free_pg(STR_PAGES)) != NULL) \
LOCK(Pg_lock(STR_PAGES)); \ PgHd_previous(PgHd_next(pg_hd)) = pg_hd; \
if ((PgHd_next(pg_hd) = Pg_free_pg(STR_PAGES)) != NULL) \ Pg_free_pg(STR_PAGES) = pg_hd; \
PgHd_previous(PgHd_next(pg_hd)) = pg_hd; \ UNLOCK(Pg_lock(STR_PAGES)); \
Pg_free_pg(STR_PAGES) = pg_hd; \ } \
UNLOCK(Pg_lock(STR_PAGES)); \
} \
} }
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \ #define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
if ((STR = LOCAL_next_free_ans_node) == NULL) { \ if ((STR = LOCAL_next_free_ans_node) == NULL) { \
pg_hd_ptr pg_hd; \ pg_hd_ptr pg_hd; \
LOCK(Pg_lock(STR_PAGES)); \ LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_requests(STR_PAGES), 1); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \ if (Pg_free_pg(STR_PAGES)) { \
if (Pg_free_pg(STR_PAGES)) { \ pg_hd = Pg_free_pg(STR_PAGES); \
pg_hd = Pg_free_pg(STR_PAGES); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), -PgHd_str_in_use(pg_hd)); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -PgHd_str_in_use(pg_hd)); \ PgHd_str_in_use(pg_hd) = Pg_str_per_pg(STR_PAGES); \
PgHd_str_in_use(pg_hd) = Pg_str_per_pg(STR_PAGES); \ STR = (STR_TYPE *) PgHd_free_str(pg_hd); \
STR = (STR_TYPE *) PgHd_free_str(pg_hd); \ PgHd_free_str(pg_hd) = NULL; \
PgHd_free_str(pg_hd) = NULL; \ Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd); \
Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd); \ UNLOCK(Pg_lock(STR_PAGES)); \
UNLOCK(Pg_lock(STR_PAGES)); \ } else { \
} else { \ int i; \
int i; \ UPDATE_STATS(Pg_pg_alloc(STR_PAGES), 1); \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), 1); \ UNLOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_str_alloc(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \ ALLOC_PAGE(pg_hd); \
UNLOCK(Pg_lock(STR_PAGES)); \ PgHd_str_in_use(pg_hd) = Pg_str_per_pg(STR_PAGES); \
ALLOC_PAGE(pg_hd); \ PgHd_free_str(pg_hd) = NULL; \
PgHd_str_in_use(pg_hd) = Pg_str_per_pg(STR_PAGES); \ PgHd_previous(pg_hd) = NULL; \
PgHd_free_str(pg_hd) = NULL; \ PgHd_next(pg_hd) = NULL; \
PgHd_previous(pg_hd) = NULL; \ STR = (STR_TYPE *) (pg_hd + 1); \
PgHd_next(pg_hd) = NULL; \ for (i = Pg_str_per_pg(STR_PAGES); i != 1; i--) { \
STR = (STR_TYPE *) (pg_hd + 1); \ STRUCT_NEXT(STR) = STR + 1; \
for (i = Pg_str_per_pg(STR_PAGES); i != 1; i--) { \ STR++; \
STRUCT_NEXT(STR) = STR + 1; \ } \
STR++; \ STRUCT_NEXT(STR) = NULL; \
} \ STR = (STR_TYPE *) (pg_hd + 1); \
STRUCT_NEXT(STR) = NULL; \ } \
STR = (STR_TYPE *) (pg_hd + 1); \ } \
} \
} \
LOCAL_next_free_ans_node = STRUCT_NEXT(STR) LOCAL_next_free_ans_node = STRUCT_NEXT(STR)
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \ #define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ pg_hd_ptr pg_hd; \ { pg_hd_ptr pg_hd; \
pg_hd = PAGE_HEADER(STR); \ pg_hd = PAGE_HEADER(STR); \
LOCK(Pg_lock(STR_PAGES)); \ LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_requests(STR_PAGES), 1); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \ if (--PgHd_str_in_use(pg_hd) == 0) { \
if (--PgHd_str_in_use(pg_hd) == 0) { \ UPDATE_STATS(Pg_pg_alloc(STR_PAGES), -1); \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), -1); \ if (PgHd_previous(pg_hd)) { \
UPDATE_STATS(Pg_str_alloc(STR_PAGES), -Pg_str_per_pg(STR_PAGES)); \ if ((PgHd_next(PgHd_previous(pg_hd)) = PgHd_next(pg_hd)) != NULL) \
if (PgHd_previous(pg_hd)) { \ PgHd_previous(PgHd_next(pg_hd)) = PgHd_previous(pg_hd); \
if ((PgHd_next(PgHd_previous(pg_hd)) = PgHd_next(pg_hd)) != NULL) \ } else { \
PgHd_previous(PgHd_next(pg_hd)) = PgHd_previous(pg_hd); \ if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \
} else { \ PgHd_previous(PgHd_next(pg_hd)) = NULL; \
if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \ } \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \ UNLOCK(Pg_lock(STR_PAGES)); \
} \ FREE_PAGE(pg_hd); \
UNLOCK(Pg_lock(STR_PAGES)); \ } else { \
FREE_PAGE(pg_hd); \ if ((STRUCT_NEXT(STR) = (STR_TYPE *) PgHd_free_str(pg_hd)) == NULL) { \
} else { \ PgHd_previous(pg_hd) = NULL; \
if ((STRUCT_NEXT(STR) = (STR_TYPE *) PgHd_free_str(pg_hd)) == NULL) { \ if ((PgHd_next(pg_hd) = Pg_free_pg(STR_PAGES)) != NULL) \
PgHd_previous(pg_hd) = NULL; \ PgHd_previous(PgHd_next(pg_hd)) = pg_hd; \
if ((PgHd_next(pg_hd) = Pg_free_pg(STR_PAGES)) != NULL) \ Pg_free_pg(STR_PAGES) = pg_hd; \
PgHd_previous(PgHd_next(pg_hd)) = pg_hd; \ } \
Pg_free_pg(STR_PAGES) = pg_hd; \ PgHd_free_str(pg_hd) = (void *) STR; \
} \ UNLOCK(Pg_lock(STR_PAGES)); \
PgHd_free_str(pg_hd) = (void *) STR; \ } \
UNLOCK(Pg_lock(STR_PAGES)); \
} \
} }
*/ #endif /* ------------------------- MEMORY_ALLOC_SCHEME -------------------------- */
#define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **ptr; \ #define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \ { int i; void **ptr; \
BUCKET_PTR = (void *) ptr; \ ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \
for (i = NUM_BUCKETS; i != 0; i--) \ BUCKET_PTR = (void *) ptr; \
*ptr++ = NULL; \ for (i = NUM_BUCKETS; i != 0; i--) \
*ptr++ = NULL; \
} }
#define FREE_HASH_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR) #define FREE_HASH_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR)
@ -233,8 +249,12 @@ extern int Yap_page_size;
#define ALLOC_SUBGOAL_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_fr, struct subgoal_frame) #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) #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) #define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_NEXT_FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#define FREE_ANSWER_TRIE_NODE(STR) 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 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) #define FREE_DEPENDENCY_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_dep_fr, struct dependency_frame)

992
OPTYap/opt.preds.c
View File

File diff suppressed because it is too large Load Diff

5
OPTYap/opt.proto.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.proto.h File: opt.proto.h
version: $Id: opt.proto.h,v 1.8 2005-06-03 08:19:17 ricroc Exp $ version: $Id: opt.proto.h,v 1.9 2005-07-11 19:17:27 ricroc Exp $
**********************************************************************/ **********************************************************************/
@ -63,7 +63,6 @@ void finish_yapor(void);
** ------------- */ ** ------------- */
#ifdef TABLING #ifdef TABLING
#include <stdio.h>
sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr); sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr);
ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr); ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr);
void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr); void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr);
@ -71,7 +70,7 @@ void private_completion(sg_fr_ptr sg_fr);
void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes); void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes);
void free_answer_trie_branch(ans_node_ptr node); void free_answer_trie_branch(ans_node_ptr node);
void update_answer_trie(sg_fr_ptr sg_fr); void update_answer_trie(sg_fr_ptr sg_fr);
void traverse_trie(sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show); void traverse_trie(tab_ent_ptr tab_ent, Atom pred_atom, int show_trie);
#endif /* TABLING */ #endif /* TABLING */

17
OPTYap/opt.structs.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.structs.h File: opt.structs.h
version: $Id: opt.structs.h,v 1.7 2005-07-06 19:34:10 ricroc Exp $ version: $Id: opt.structs.h,v 1.8 2005-07-11 19:17:27 ricroc Exp $
**********************************************************************/ **********************************************************************/
@ -24,13 +24,13 @@ typedef unsigned long bitmap;
typedef struct page_header { typedef struct page_header {
volatile int structs_in_use; volatile int structs_in_use;
void *next_free_struct; void *first_free_struct;
struct page_header *previous; struct page_header *previous;
struct page_header *next; struct page_header *next;
} *pg_hd_ptr; } *pg_hd_ptr;
#define PgHd_str_in_use(X) ((X)->structs_in_use) #define PgHd_str_in_use(X) ((X)->structs_in_use)
#define PgHd_free_str(X) ((X)->next_free_struct) #define PgHd_free_str(X) ((X)->first_free_struct)
#define PgHd_previous(X) ((X)->previous) #define PgHd_previous(X) ((X)->previous)
#define PgHd_next(X) ((X)->next) #define PgHd_next(X) ((X)->next)
@ -44,23 +44,18 @@ struct pages {
#ifdef YAPOR #ifdef YAPOR
lockvar lock; lockvar lock;
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef STATISTICS
volatile long pages_allocated; volatile long pages_allocated;
volatile long structs_allocated;
volatile long structs_in_use; volatile long structs_in_use;
volatile long requests;
#endif /* STATISTICS */
int structs_per_page; int structs_per_page;
struct page_header *free_pages; struct page_header *first_free_page;
}; };
#define Pg_lock(X) ((X).lock) #define Pg_lock(X) ((X).lock)
#define Pg_pg_alloc(X) ((X).pages_allocated) #define Pg_pg_alloc(X) ((X).pages_allocated)
#define Pg_str_alloc(X) ((X).structs_allocated)
#define Pg_str_in_use(X) ((X).structs_in_use) #define Pg_str_in_use(X) ((X).structs_in_use)
#define Pg_requests(X) ((X).requests)
#define Pg_str_per_pg(X) ((X).structs_per_page) #define Pg_str_per_pg(X) ((X).structs_per_page)
#define Pg_free_pg(X) ((X).free_pages) #define Pg_free_pg(X) ((X).first_free_page)
#define Pg_str_free(X) (Pg_pg_alloc(X) * Pg_str_per_pg(X) - Pg_str_in_use(X))

23
OPTYap/tab.macros.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.macros.h File: tab.macros.h
version: $Id: tab.macros.h,v 1.14 2005-07-06 19:34:10 ricroc Exp $ version: $Id: tab.macros.h,v 1.15 2005-07-11 19:17:27 ricroc Exp $
**********************************************************************/ **********************************************************************/
@ -233,7 +233,6 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
INIT_LOCK(SgFr_lock(SG_FR)); \ INIT_LOCK(SgFr_lock(SG_FR)); \
SgFr_tab_ent(SG_FR) = TAB_ENT; \ SgFr_tab_ent(SG_FR) = TAB_ENT; \
SgFr_arity(SG_FR) = ARITY; \ SgFr_arity(SG_FR) = ARITY; \
SgFr_abolish(SG_FR) = 0; \
new_answer_trie_node(ans_node, 0, 0, NULL, NULL, NULL); \ new_answer_trie_node(ans_node, 0, 0, NULL, NULL, NULL); \
SgFr_answer_trie(SG_FR) = ans_node; \ SgFr_answer_trie(SG_FR) = ans_node; \
SgFr_hash_chain(SG_FR) = NULL; \ SgFr_hash_chain(SG_FR) = NULL; \
@ -518,22 +517,11 @@ void abolish_incomplete_subgoals(choiceptr prune_cp) {
sg_fr = LOCAL_top_sg_fr; sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(sg_fr); LOCAL_top_sg_fr = SgFr_next(sg_fr);
LOCK(SgFr_lock(sg_fr)); LOCK(SgFr_lock(sg_fr));
if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) { if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) /* yes answer --> complete */
/* yes answer --> complete */
SgFr_state(sg_fr) = complete; SgFr_state(sg_fr) = complete;
UNLOCK(SgFr_lock(sg_fr)); else
} else {
ans_node_ptr node;
SgFr_state(sg_fr) = start; SgFr_state(sg_fr) = start;
SgFr_abolish(sg_fr)++; UNLOCK(SgFr_lock(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; return;
@ -668,11 +656,12 @@ susp_fr_ptr suspension_frame_to_resume(or_fr_ptr susp_or_fr) {
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING_INNER_CUTS
/* --------------------------------------------------- ** /* --------------------------------------------------- **
** Cut Stuff: Managing table subgoal answers ** ** Cut Stuff: Managing table subgoal answers **
** --------------------------------------------------- */ ** --------------------------------------------------- */
#ifdef TABLING_INNER_CUTS
static inline static inline
void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr gen_cp, int ltt) { 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_sol_fr_ptr tg_sol_fr, *solution_ptr, next, ltt_next;

25
OPTYap/tab.structs.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.structs.h File: tab.structs.h
version: $Id: tab.structs.h,v 1.7 2005-07-06 19:34:10 ricroc Exp $ version: $Id: tab.structs.h,v 1.8 2005-07-11 19:17:29 ricroc Exp $
**********************************************************************/ **********************************************************************/
@ -13,14 +13,14 @@
** Tabling mode flags ** ** Tabling mode flags **
** ---------------------------- */ ** ---------------------------- */
#define Mode_SchedulingOn 0x10000000L /* yap_flags[TABLING_MODE_FLAG] */ #define Mode_SchedulingOn 0x00000001L /* yap_flags[TABLING_MODE_FLAG] */
#define Mode_CompletedOn 0x20000000L /* yap_flags[TABLING_MODE_FLAG] */ #define Mode_CompletedOn 0x00000002L /* yap_flags[TABLING_MODE_FLAG] */
#define Mode_Local 0x00000010L /* yap_flags[TABLING_MODE_FLAG] + table_entry */ #define Mode_Local 0x10000000L /* yap_flags[TABLING_MODE_FLAG] + struct table_entry */
#define Mode_LoadAnswers 0x00000020L /* yap_flags[TABLING_MODE_FLAG] + table_entry */ #define Mode_LoadAnswers 0x20000000L /* yap_flags[TABLING_MODE_FLAG] + struct table_entry */
#define DefaultMode_Local 0x00000001L /* table_entry */ #define DefaultMode_Local 0x00000001L /* struct table_entry */
#define DefaultMode_LoadAnswers 0x00000002L /* table_entry */ #define DefaultMode_LoadAnswers 0x00000002L /* struct table_entry */
#define SetMode_SchedulingOn(X) (X) |= Mode_SchedulingOn #define SetMode_SchedulingOn(X) (X) |= Mode_SchedulingOn
#define SetMode_CompletedOn(X) (X) |= Mode_CompletedOn #define SetMode_CompletedOn(X) (X) |= Mode_CompletedOn
@ -156,17 +156,16 @@ typedef struct subgoal_frame {
#endif /* YAPOR */ #endif /* YAPOR */
struct table_entry *tab_ent; struct table_entry *tab_ent;
int subgoal_arity; int subgoal_arity;
int abolish_operations;
choiceptr generator_choice_point; choiceptr generator_choice_point;
struct answer_trie_node *answer_trie; struct answer_trie_node *answer_trie;
struct answer_trie_node *first_answer; struct answer_trie_node *first_answer;
struct answer_trie_node *last_answer; struct answer_trie_node *last_answer;
struct answer_hash *hash_chain; struct answer_hash *hash_chain;
enum { enum {
start = 0, start = 0,
evaluating = 1, evaluating = 1,
complete = 2, complete = 2,
compiled = 3 compiled = 3
} state_flag; } state_flag;
struct subgoal_frame *next; struct subgoal_frame *next;
} *sg_fr_ptr; } *sg_fr_ptr;
@ -176,7 +175,6 @@ typedef struct subgoal_frame {
#define SgFr_gen_top_or_fr(X) ((X)->top_or_frame_on_generator_branch) #define SgFr_gen_top_or_fr(X) ((X)->top_or_frame_on_generator_branch)
#define SgFr_tab_ent(X) ((X)->tab_ent) #define SgFr_tab_ent(X) ((X)->tab_ent)
#define SgFr_arity(X) ((X)->subgoal_arity) #define SgFr_arity(X) ((X)->subgoal_arity)
#define SgFr_abolish(X) ((X)->abolish_operations)
#define SgFr_gen_cp(X) ((X)->generator_choice_point) #define SgFr_gen_cp(X) ((X)->generator_choice_point)
#define SgFr_answer_trie(X) ((X)->answer_trie) #define SgFr_answer_trie(X) ((X)->answer_trie)
#define SgFr_first_answer(X) ((X)->first_answer) #define SgFr_first_answer(X) ((X)->first_answer)
@ -194,7 +192,6 @@ typedef struct subgoal_frame {
consumer nodes in other workers branches. consumer nodes in other workers branches.
SgFr_tab_ent a pointer to the correspondent table entry. SgFr_tab_ent a pointer to the correspondent table entry.
SgFr_arity the arity of the subgoal. SgFr_arity the arity of the subgoal.
SgFr_abolish the number of times the subgoal was abolished.
SgFr_gen_cp: a pointer to the correspondent generator choice point. SgFr_gen_cp: a pointer to the correspondent generator choice point.
SgFr_answer_trie: a pointer to the top answer trie node. SgFr_answer_trie: a pointer to the top answer trie node.
It is used to check for/insert new answers. It is used to check for/insert new answers.

117
OPTYap/tab.tries.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.tries.C File: tab.tries.C
version: $Id: tab.tries.c,v 1.13 2005-07-06 19:34:10 ricroc Exp $ version: $Id: tab.tries.c,v 1.14 2005-07-11 19:17:29 ricroc Exp $
**********************************************************************/ **********************************************************************/
@ -161,7 +161,7 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
new_subgoal_trie_node(new_node, t, NULL, parent_node, first_node); new_subgoal_trie_node(new_node, t, NULL, parent_node, first_node);
#endif /* ALLOC_BEFORE_CHECK */ #endif /* ALLOC_BEFORE_CHECK */
} }
if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) {
/* alloc a new hash */ /* alloc a new hash */
sg_node_ptr next_node, *bucket; sg_node_ptr next_node, *bucket;
new_subgoal_hash(hash, count_nodes, tab_ent); new_subgoal_hash(hash, count_nodes, tab_ent);
@ -234,7 +234,7 @@ subgoal_hash:
} }
*bucket = new_node; *bucket = new_node;
Hash_num_nodes(hash)++; Hash_num_nodes(hash)++;
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */ /* expand current hash */
sg_node_ptr next_node, *first_old_bucket, *old_bucket; sg_node_ptr next_node, *first_old_bucket, *old_bucket;
first_old_bucket = Hash_buckets(hash); first_old_bucket = Hash_buckets(hash);
@ -362,7 +362,7 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
new_answer_trie_node(new_node, instr, t, NULL, parent_node, first_node); new_answer_trie_node(new_node, instr, t, NULL, parent_node, first_node);
#endif /* ALLOC_BEFORE_CHECK */ #endif /* ALLOC_BEFORE_CHECK */
} }
if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) {
/* alloc a new hash */ /* alloc a new hash */
ans_node_ptr next_node, *bucket; ans_node_ptr next_node, *bucket;
new_answer_hash(hash, count_nodes, sg_fr); new_answer_hash(hash, count_nodes, sg_fr);
@ -435,7 +435,7 @@ answer_hash:
} }
*bucket = new_node; *bucket = new_node;
Hash_num_nodes(hash)++; Hash_num_nodes(hash)++;
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */ /* expand current hash */
ans_node_ptr next_node, *first_old_bucket, *old_bucket; ans_node_ptr next_node, *first_old_bucket, *old_bucket;
first_old_bucket = Hash_buckets(hash); first_old_bucket = Hash_buckets(hash);
@ -500,7 +500,7 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
child_node = TrNode_next(child_node); child_node = TrNode_next(child_node);
} while (child_node); } while (child_node);
new_subgoal_trie_node(child_node, t, NULL, parent_node, TrNode_child(parent_node)); new_subgoal_trie_node(child_node, t, NULL, parent_node, TrNode_child(parent_node));
if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) {
/* alloc a new hash */ /* alloc a new hash */
sg_hash_ptr hash; sg_hash_ptr hash;
sg_node_ptr chain_node, next_node, *bucket; sg_node_ptr chain_node, next_node, *bucket;
@ -540,7 +540,7 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
Hash_num_nodes(hash)++; Hash_num_nodes(hash)++;
new_subgoal_trie_node(child_node, t, NULL, parent_node, *bucket); new_subgoal_trie_node(child_node, t, NULL, parent_node, *bucket);
*bucket = child_node; *bucket = child_node;
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */ /* expand current hash */
sg_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; sg_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
int seed; int seed;
@ -600,7 +600,7 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
child_node = TrNode_next(child_node); child_node = TrNode_next(child_node);
} while (child_node); } while (child_node);
new_answer_trie_node(child_node, instr, t, NULL, parent_node, TrNode_child(parent_node)); new_answer_trie_node(child_node, instr, t, NULL, parent_node, TrNode_child(parent_node));
if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) {
/* alloc a new hash */ /* alloc a new hash */
ans_hash_ptr hash; ans_hash_ptr hash;
ans_node_ptr chain_node, next_node, *bucket; ans_node_ptr chain_node, next_node, *bucket;
@ -640,7 +640,7 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
Hash_num_nodes(hash)++; Hash_num_nodes(hash)++;
new_answer_trie_node(child_node, instr, t, NULL, parent_node, *bucket); new_answer_trie_node(child_node, instr, t, NULL, parent_node, *bucket);
*bucket = child_node; *bucket = child_node;
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */ /* expand current hash */
ans_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; ans_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
int seed; int seed;
@ -1034,8 +1034,7 @@ void update_answer_trie(sg_fr_ptr sg_fr) {
static struct trie_statistics{ static struct trie_statistics{
int show; int show;
long subgoals; long subgoals;
long subgoals_abolished; long subgoals_not_complete;
long subgoals_abolish_operations;
long subgoal_trie_nodes; long subgoal_trie_nodes;
long subgoal_linear_nodes; long subgoal_linear_nodes;
int subgoal_trie_max_depth; int subgoal_trie_max_depth;
@ -1051,8 +1050,7 @@ static struct trie_statistics{
} trie_stats; } trie_stats;
#define TrStat_show trie_stats.show #define TrStat_show trie_stats.show
#define TrStat_subgoals trie_stats.subgoals #define TrStat_subgoals trie_stats.subgoals
#define TrStat_sg_abolished trie_stats.subgoals_abolished #define TrStat_sg_not_complete trie_stats.subgoals_not_complete
#define TrStat_sg_abolish_operations trie_stats.subgoals_abolish_operations
#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes #define TrStat_sg_nodes trie_stats.subgoal_trie_nodes
#define TrStat_sg_linear_nodes trie_stats.subgoal_linear_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_max_depth trie_stats.subgoal_trie_max_depth
@ -1071,15 +1069,16 @@ static struct trie_statistics{
#define SHOW_INFO(MESG, ARGS...) fprintf(Yap_stderr, MESG, ##ARGS) #define SHOW_INFO(MESG, ARGS...) fprintf(Yap_stderr, MESG, ##ARGS)
#define SHOW_TRIE(MESG, ARGS...) if (TrStat_show) fprintf(Yap_stderr, MESG, ##ARGS) #define SHOW_TRIE(MESG, ARGS...) if (TrStat_show) fprintf(Yap_stderr, MESG, ##ARGS)
void traverse_trie(sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show) { void traverse_trie(tab_ent_ptr tab_ent, Atom pred_atom, int show_trie) {
char str[STR_ARRAY_SIZE]; char str[STR_ARRAY_SIZE];
int arity[ARITY_ARRAY_SIZE]; int arity[ARITY_ARRAY_SIZE];
int str_index; int str_index;
int pred_arity = TabEnt_arity(tab_ent);
sg_node_ptr sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent));
TrStat_show = show; TrStat_show = show_trie;
TrStat_subgoals = 0; TrStat_subgoals = 0;
TrStat_sg_abolished = 0; TrStat_sg_not_complete = 0;
TrStat_sg_abolish_operations = 0;
TrStat_sg_nodes = 0; TrStat_sg_nodes = 0;
TrStat_sg_linear_nodes = 0; TrStat_sg_linear_nodes = 0;
TrStat_sg_max_depth = -1; TrStat_sg_max_depth = -1;
@ -1095,42 +1094,40 @@ void traverse_trie(sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show
str_index = sprintf(str, " ?- %s(", AtomName(pred_atom)); str_index = sprintf(str, " ?- %s(", AtomName(pred_atom));
arity[0] = 1; arity[0] = 1;
arity[1] = pred_arity; arity[1] = pred_arity;
SHOW_INFO("\n[ Table structure for predicate '%s/%d' ]\n", AtomName(pred_atom), pred_arity); SHOW_TRIE("\ntable structure for predicate '%s/%d'\n", AtomName(pred_atom), pred_arity);
TrStat_sg_nodes++; TrStat_sg_nodes++;
if (sg_node && ! traverse_subgoal_trie(sg_node, str, str_index, arity, 1, TRAVERSE_NORMAL)) if (sg_node && ! traverse_subgoal_trie(sg_node, str, str_index, arity, 1, TRAVERSE_NORMAL))
return; return;
SHOW_INFO("\n Subgoal Trie structure\n %ld subgoals", TrStat_subgoals); SHOW_INFO("\ntable statistics for predicate '%s/%d'", AtomName(pred_atom), pred_arity);
if (TrStat_sg_abolished) SHOW_INFO("\n subgoal trie structure");
SHOW_INFO(" including %ld abolished", TrStat_sg_abolished); SHOW_INFO("\n subgoals: %ld", TrStat_subgoals);
if (TrStat_sg_abolish_operations) SHOW_INFO("\n subgoals not complete: %ld", TrStat_sg_not_complete);
SHOW_INFO(" (%ld abolish operations executed)", TrStat_sg_abolish_operations); SHOW_INFO("\n nodes: %ld (%ld%c saving)",
SHOW_INFO("\n %ld nodes (%ld%c saving)\n %.2f average depth (%d min - %d max)",
TrStat_sg_nodes, TrStat_sg_nodes,
TrStat_sg_linear_nodes == 0 ? 0 : (TrStat_sg_linear_nodes - TrStat_sg_nodes + 1) * 100 / TrStat_sg_linear_nodes, TrStat_sg_linear_nodes == 0 ? 0 : (TrStat_sg_linear_nodes - TrStat_sg_nodes + 1) * 100 / TrStat_sg_linear_nodes,
'%', '%');
SHOW_INFO("\n average depth: %.2f (%d min - %d max)",
TrStat_subgoals == 0 ? 0 : (float)TrStat_sg_linear_nodes / (float)TrStat_subgoals, TrStat_subgoals == 0 ? 0 : (float)TrStat_sg_linear_nodes / (float)TrStat_subgoals,
TrStat_sg_min_depth < 0 ? 0 : TrStat_sg_min_depth, TrStat_sg_min_depth < 0 ? 0 : TrStat_sg_min_depth,
TrStat_sg_max_depth < 0 ? 0 : TrStat_sg_max_depth); TrStat_sg_max_depth < 0 ? 0 : TrStat_sg_max_depth);
SHOW_INFO("\n Answer Trie Structure\n "); SHOW_INFO("\n answer trie structure");
if (TrStat_answers_yes) SHOW_INFO("\n answers: %ld", TrStat_answers);
SHOW_INFO("%ld yes answers/", TrStat_answers_yes); SHOW_INFO("\n yes answers: %ld", TrStat_answers_yes);
SHOW_INFO("%ld answers", TrStat_answers); SHOW_INFO("\n no answers: %ld", TrStat_answers_no);
if (TrStat_ans_pruned) SHOW_INFO("\n pruned answers: %ld", TrStat_ans_pruned);
SHOW_INFO(" including %ld pruned", TrStat_ans_pruned); SHOW_INFO("\n nodes: %ld (%ld%c saving)",
if (TrStat_answers_no)
SHOW_INFO(" (%ld no answers)", TrStat_answers_no);
SHOW_INFO("\n %ld nodes (%ld%c saving)\n %.2f average depth (%d min - %d max)",
TrStat_ans_nodes, TrStat_ans_nodes,
TrStat_ans_linear_nodes == 0 ? 0 : (TrStat_ans_linear_nodes - TrStat_ans_nodes + TrStat_subgoals) * 100 / TrStat_ans_linear_nodes, TrStat_ans_linear_nodes == 0 ? 0 : (TrStat_ans_linear_nodes - TrStat_ans_nodes + TrStat_subgoals) * 100 / TrStat_ans_linear_nodes,
'%', '%');
SHOW_INFO("\n average depth: %.2f (%d min - %d max)",
TrStat_answers == 0 ? 0 : (float)TrStat_ans_linear_nodes / (float)TrStat_answers, TrStat_answers == 0 ? 0 : (float)TrStat_ans_linear_nodes / (float)TrStat_answers,
TrStat_ans_min_depth < 0 ? 0 : TrStat_ans_min_depth, TrStat_ans_min_depth < 0 ? 0 : TrStat_ans_min_depth,
TrStat_ans_max_depth < 0 ? 0 : TrStat_ans_max_depth); TrStat_ans_max_depth < 0 ? 0 : TrStat_ans_max_depth);
SHOW_INFO("\n Total Memory Used\n %ld bytes", SHOW_INFO("\n total memory in use\n %ld bytes\n\n",
TrStat_sg_nodes * sizeof(struct subgoal_trie_node) + sizeof(struct table_entry) +
TrStat_sg_nodes * sizeof(struct subgoal_trie_node) +
TrStat_ans_nodes * sizeof(struct answer_trie_node) + TrStat_ans_nodes * sizeof(struct answer_trie_node) +
TrStat_subgoals * sizeof(struct subgoal_frame)); TrStat_subgoals * sizeof(struct subgoal_frame));
SHOW_INFO("\n\n");
return; return;
} }
@ -1423,7 +1420,6 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar
sg_fr_ptr sg_fr = (sg_fr_ptr) TrNode_child(sg_node); sg_fr_ptr sg_fr = (sg_fr_ptr) TrNode_child(sg_node);
str[str_index] = 0; str[str_index] = 0;
TrStat_subgoals++; TrStat_subgoals++;
TrStat_sg_abolish_operations += SgFr_abolish(sg_fr);
TrStat_sg_linear_nodes+= depth; TrStat_sg_linear_nodes+= depth;
if (TrStat_sg_max_depth < 0) { if (TrStat_sg_max_depth < 0) {
TrStat_sg_min_depth = TrStat_sg_max_depth = depth; TrStat_sg_min_depth = TrStat_sg_max_depth = depth;
@ -1432,33 +1428,26 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar
} else if (depth > TrStat_sg_max_depth) { } else if (depth > TrStat_sg_max_depth) {
TrStat_sg_max_depth = depth; TrStat_sg_max_depth = depth;
} }
if (SgFr_state(sg_fr) == start) { if (SgFr_state(sg_fr) == start || SgFr_state(sg_fr) == evaluating) {
TrStat_sg_abolished++; TrStat_sg_not_complete++;
SHOW_TRIE("%s.\n ABOLISHED\n", str); SHOW_TRIE("%s. ---> NOT COMPLETE\n", str);
} else {
SHOW_TRIE("%s.\n", str);
} }
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);
TrStat_ans_nodes++; TrStat_ans_nodes++;
if (SgFr_first_answer(sg_fr) == NULL) { if (SgFr_first_answer(sg_fr) == NULL) {
if (TrStat_ans_max_depth < 0) if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0; TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0; TrStat_ans_min_depth = 0;
TrStat_answers_no++; TrStat_answers_no++;
SHOW_TRIE(" NO\n"); SHOW_TRIE(" NO ANSWERS\n");
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) { } else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
if (TrStat_ans_max_depth < 0) if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0; TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0; TrStat_ans_min_depth = 0;
TrStat_answers_yes++; TrStat_answers_yes++;
TrStat_answers++; TrStat_answers++;
SHOW_TRIE(" YES\n"); SHOW_TRIE(" TRUE\n");
} else { } else {
char answer_str[STR_ARRAY_SIZE]; char answer_str[STR_ARRAY_SIZE];
int answer_arity[ARITY_ARRAY_SIZE]; int answer_arity[ARITY_ARRAY_SIZE];
@ -1493,6 +1482,24 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a
memcpy(old_arity, arity, sizeof(int) * (arity[0] + 1)); memcpy(old_arity, arity, sizeof(int) * (arity[0] + 1));
t = TrNode_entry(ans_node); t = TrNode_entry(ans_node);
/* test if hashing */
if (IS_ANSWER_HASH(ans_node)) {
ans_node_ptr *bucket, *last_bucket;
ans_hash_ptr hash;
hash = (ans_hash_ptr) ans_node;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
do {
if (*bucket) {
ans_node = *bucket;
if (! traverse_answer_trie(ans_node, str, str_index, arity, var_index, depth, mode))
return FALSE;
memcpy(arity, old_arity, sizeof(int) * (old_arity[0] + 1));
}
} while (++bucket != last_bucket);
return TRUE;
}
/* print VAR when starting a term */ /* print VAR when starting a term */
if (arity[0] == 0 && mode == TRAVERSE_NORMAL) { if (arity[0] == 0 && mode == TRAVERSE_NORMAL) {
str_index += sprintf(& str[str_index], " VAR%d: ", var_index); str_index += sprintf(& str[str_index], " VAR%d: ", var_index);

185
pl/tabling.yap
View File

@ -15,7 +15,7 @@
* * * *
*************************************************************************/ *************************************************************************/
:- meta_predicate table(:), tabling_mode(:), abolish_table(:), show_table(:), show_table_stats(:). :- meta_predicate table(:), tabling_mode(:), abolish_table(:), show_table(:), table_statistics(:).
@ -23,19 +23,40 @@
* table/1 * * table/1 *
******************/ ******************/
table(P) :- '$current_module'(M), '$table'(P,M). table(Pred) :-
'$current_module'(Mod),
'$do_table'(Mod,Pred).
'$table'(P,M) :- var(P), !, '$do_error'(instantiation_error,table(M:P)). '$do_table'(Mod,Pred) :-
'$table'(M:P,_) :- !, '$table'(P,M). var(Pred), !,
'$table'([],_) :- !. '$do_error'(instantiation_error,table(Mod:Pred)).
'$table'([H|T],M) :- !, '$table'(H,M), '$table'(T,M). '$do_table'(_,Mod:Pred) :- !,
'$table'((P1,P2),M) :- !, '$table'(P1,M), '$table'(P2,M). '$do_table'(Mod,Pred).
'$table'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$declare_tabled'(T,M). '$do_table'(_,[]) :- !.
'$table'(P,M) :- '$do_error'(type_error(callable,P),table(M:P)). '$do_table'(Mod,[HPred|TPred]) :- !,
'$do_table'(Mod,HPred),
'$do_table'(Mod,TPred).
'$do_table'(Mod,(Pred1,Pred2)) :- !,
'$do_table'(Mod,Pred1),
'$do_table'(Mod,Pred2).
'$do_table'(Mod,PredName/PredArity) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity), !,
'$set_table'(Mod,PredFunctor).
'$do_table'(Mod,Pred) :-
'$do_error'(type_error(callable,Mod:Pred),table(Mod:Pred)).
'$declare_tabled'(T,M) :- '$undefined'(T,M), !, '$do_table'(T,M). '$set_table'(Mod,PredFunctor) :-
'$declare_tabled'(T,M) :- '$flags'(T,M,F,F), F /\ 0x1991F880 =:= 0, !, '$do_table'(T,M). '$undefined'(PredFunctor,Mod), !,
'$declare_tabled'(T,M) :- functor(T,A,N), '$do_error'(permission_error(modify,table,M:A/N),table(M:A/N)). '$c_table'(Mod,PredFunctor).
'$set_table'(Mod,PredFunctor) :-
'$flags'(PredFunctor,Mod,Flags,Flags),
Flags /\ 0x1991F880 =:= 0, !,
'$c_table'(Mod,PredFunctor).
'$set_table'(Mod,PredFunctor) :-
functor(PredFunctor,PredName,PredArity),
'$do_error'(permission_error(modify,table,Mod:PredName/PredArity),table(Mod:PredName/PredArity)).
@ -45,38 +66,38 @@ table(P) :- '$current_module'(M), '$table'(P,M).
tabling_mode(Pred,Options) :- tabling_mode(Pred,Options) :-
'$current_module'(Mod), '$current_module'(Mod),
'$tabling_mode'(Mod,Pred,Options). '$do_tabling_mode'(Mod,Pred,Options).
'$tabling_mode'(Mod,Pred,Options) :- '$do_tabling_mode'(Mod,Pred,Options) :-
var(Pred), !, var(Pred), !,
'$do_error'(instantiation_error,tabling_mode(Mod:Pred,Options)). '$do_error'(instantiation_error,tabling_mode(Mod:Pred,Options)).
'$tabling_mode'(_,Mod:Pred,Options) :- !, '$do_tabling_mode'(_,Mod:Pred,Options) :- !,
'$tabling_mode'(Mod,Pred,Options). '$do_tabling_mode'(Mod,Pred,Options).
'$tabling_mode'(_,[],_) :- !. '$do_tabling_mode'(_,[],_) :- !.
'$tabling_mode'(Mod,[HPred|TPred],Options) :- !, '$do_tabling_mode'(Mod,[HPred|TPred],Options) :- !,
'$tabling_mode'(Mod,HPred,Options), '$do_tabling_mode'(Mod,HPred,Options),
'$tabling_mode'(Mod,TPred,Options). '$do_tabling_mode'(Mod,TPred,Options).
'$tabling_mode'(Mod,PredName/PredArity,Options) :- '$do_tabling_mode'(Mod,PredName/PredArity,Options) :-
atom(PredName), atom(PredName),
integer(PredArity), !, integer(PredArity),
functor(PredFunctor,PredName,PredArity), functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), '$flags'(PredFunctor,Mod,Flags,Flags), !,
(Flags /\ 0x000040 =\= 0, !, '$set_tabling_mode'(Mod,PredFunctor,Options) (Flags /\ 0x000040 =\= 0, !, '$set_tabling_mode'(Mod,PredFunctor,Options)
; ;
'$do_error'(domain_error(table,Mod:PredName/PredArity),tabling_mode(Mod:PredName/PredArity,Options))). '$do_error'(domain_error(table,Mod:PredName/PredArity),tabling_mode(Mod:PredName/PredArity,Options))).
'$tabling_mode'(Mod,Pred,Options) :- '$do_tabling_mode'(Mod,Pred,Options) :-
'$do_error'(type_error(callable,Pred),tabling_mode(Mod:Pred,Options)). '$do_error'(type_error(callable,Mod:Pred),tabling_mode(Mod:Pred,Options)).
'$set_tabling_mode'(Mod,PredFunctor,Options) :- '$set_tabling_mode'(Mod,PredFunctor,Options) :-
var(Options), !, var(Options), !,
'$do_tabling_mode'(Mod,PredFunctor,Options). '$c_tabling_mode'(Mod,PredFunctor,Options).
'$set_tabling_mode'(Mod,PredFunctor,[]) :- !. '$set_tabling_mode'(Mod,PredFunctor,[]) :- !.
'$set_tabling_mode'(Mod,PredFunctor,[HOption|TOption]) :- !, '$set_tabling_mode'(Mod,PredFunctor,[HOption|TOption]) :- !,
'$set_tabling_mode'(Mod,PredFunctor,HOption), '$set_tabling_mode'(Mod,PredFunctor,HOption),
'$set_tabling_mode'(Mod,PredFunctor,TOption). '$set_tabling_mode'(Mod,PredFunctor,TOption).
'$set_tabling_mode'(Mod,PredFunctor,Option) :- '$set_tabling_mode'(Mod,PredFunctor,Option) :-
(Option = batched ; Option = local ; Option = exec_answers ; Option = load_answers), !, (Option = batched ; Option = local ; Option = exec_answers ; Option = load_answers), !,
'$do_tabling_mode'(Mod,PredFunctor,Option). '$c_tabling_mode'(Mod,PredFunctor,Option).
'$set_tabling_mode'(Mod,PredFunctor,Options) :- '$set_tabling_mode'(Mod,PredFunctor,Options) :-
functor(PredFunctor,PredName,PredArity), functor(PredFunctor,PredName,PredArity),
'$do_error'(domain_error(flag_value,tabling_mode+Options),tabling_mode(Mod:PredName/PredArity,Options)). '$do_error'(domain_error(flag_value,tabling_mode+Options),tabling_mode(Mod:PredName/PredArity,Options)).
@ -87,18 +108,32 @@ tabling_mode(Pred,Options) :-
* abolish_table/1 * * abolish_table/1 *
**************************/ **************************/
abolish_table(P) :- '$current_module'(M), '$abolish_table'(P,M). abolish_table(Pred) :-
'$current_module'(Mod),
'$do_abolish_table'(Mod,Pred).
'$abolish_table'(P,M) :- var(P), !, '$do_error'(instantiation_error,abolish_table(M:P)). '$do_abolish_table'(Mod,Pred) :-
'$abolish_table'(M:P,_) :- !, '$abolish_table'(P,M). var(Pred), !,
'$abolish_table'([],_) :- !. '$do_error'(instantiation_error,abolish_table(Mod:Pred)).
'$abolish_table'([H|T],M) :- !, '$abolish_table'(H,M), '$abolish_table'(T,M). '$do_abolish_table'(_,Mod:Pred) :- !,
'$abolish_table'((P1,P2),M) :- !, '$abolish_table'(P1,M), '$abolish_table'(P2,M). '$do_abolish_table'(Mod,Pred).
'$abolish_table'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F), '$do_abolish_table'(_,[]) :- !.
(F /\ 0x000040 =\= 0, !, '$do_abolish_table'(T,M) '$do_abolish_table'(Mod,[HPred|TPred]) :- !,
; '$do_abolish_table'(Mod,HPred),
'$do_error'(domain_error(table,M:A/N),abolish_table(M:A/N))). '$do_abolish_table'(Mod,TPred).
'$abolish_table'(P,M) :- '$do_error'(type_error(callable,P),abolish_table(M:P)). '$do_abolish_table'(Mod,(Pred1,Pred2)) :- !,
'$do_abolish_table'(Mod,Pred1),
'$do_abolish_table'(Mod,Pred2).
'$do_abolish_table'(Mod,PredName/PredArity) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
(Flags /\ 0x000040 =\= 0, !, '$c_abolish_table'(Mod,PredFunctor)
;
'$do_error'(domain_error(table,Mod:PredName/PredArity),abolish_table(Mod:PredName/PredArity))).
'$do_abolish_table'(Mod,Pred) :-
'$do_error'(type_error(callable,Mod:Pred),abolish_table(Mod:Pred)).
@ -106,34 +141,62 @@ abolish_table(P) :- '$current_module'(M), '$abolish_table'(P,M).
* show_table/1 * * show_table/1 *
***********************/ ***********************/
show_table(P) :- '$current_module'(M), '$show_table'(P,M). show_table(Pred) :-
'$current_module'(Mod),
'$do_show_table'(Mod,Pred).
'$show_table'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_table(M:P)). '$do_show_table'(Mod,Pred) :-
'$show_table'(M:P,_) :- !, '$show_table'(P,M). var(Pred), !,
'$show_table'([],_) :- !. '$do_error'(instantiation_error,show_table(Mod:Pred)).
'$show_table'([H|T],M) :- !, '$show_table'(H,M), '$show_table'(T,M). '$do_show_table'(_,Mod:Pred) :- !,
'$show_table'((P1,P2),M) :- !, '$show_table'(P1,M), '$show_table'(P2,M). '$do_show_table'(Mod,Pred).
'$show_table'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F), '$do_show_table'(_,[]) :- !.
(F /\ 0x000040 =\= 0, !, '$do_show_table'(T,M) '$do_show_table'(Mod,[HPred|TPred]) :- !,
; '$do_show_table'(Mod,HPred),
'$do_error'(domain_error(table,M:A/N),show_table(M:A/N))). '$do_show_table'(Mod,TPred).
'$show_table'(P,M) :- '$do_error'(type_error(callable,P),show_table(M:P)). '$do_show_table'(Mod,(Pred1,Pred2)) :- !,
'$do_show_table'(Mod,Pred1),
'$do_show_table'(Mod,Pred2).
'$do_show_table'(Mod,PredName/PredArity) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
(Flags /\ 0x000040 =\= 0, !, '$c_show_table'(Mod,PredFunctor)
;
'$do_error'(domain_error(table,Mod:PredName/PredArity),show_table(Mod:PredName/PredArity))).
'$do_show_table'(Mod,Pred) :-
'$do_error'(type_error(callable,Mod:Pred),show_table(Mod:Pred)).
/***************************** /*****************************
* show_table_stats/1 * * table_statistics/1 *
*****************************/ *****************************/
show_table_stats(P) :- '$current_module'(M), '$show_table_stats'(P,M). table_statistics(Pred) :-
'$current_module'(Mod),
'$do_table_statistics'(Mod,Pred).
'$show_table_stats'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_table_stats(M:P)). '$do_table_statistics'(Mod,Pred) :-
'$show_table_stats'(M:P,_) :- !, '$show_table_stats'(P,M). var(Pred), !,
'$show_table_stats'([],_) :- !. '$do_error'(instantiation_error,table_statistics(Mod:Pred)).
'$show_table_stats'([H|T],M) :- !, '$show_table_stats'(H,M), '$show_table_stats'(T,M). '$do_table_statistics'(_,Mod:Pred) :- !,
'$show_table_stats'((P1,P2),M) :- !, '$show_table_stats'(P1,M), '$show_table_stats'(P2,M). '$do_table_statistics'(Mod,Pred).
'$show_table_stats'(A/N,M) :- atom(A), integer(N), !, functor(T,A,N), '$flags'(T,M,F,F), '$do_table_statistics'(_,[]) :- !.
(F /\ 0x000040 =\= 0, !, '$do_show_table_stats'(T,M) '$do_table_statistics'(Mod,[HPred|TPred]) :- !,
; '$do_table_statistics'(Mod,HPred),
'$do_error'(domain_error(table,M:A/N),show_table_stats(M:A/N))). '$do_table_statistics'(Mod,TPred).
'$show_table_stats'(P,M) :- '$do_error'(type_error(callable,P),show_table_stats(M:P)). '$do_table_statistics'(Mod,(Pred1,Pred2)) :- !,
'$do_table_statistics'(Mod,Pred1),
'$do_table_statistics'(Mod,Pred2).
'$do_table_statistics'(Mod,PredName/PredArity) :-
atom(PredName),
integer(PredArity),
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags), !,
(Flags /\ 0x000040 =\= 0, !, '$c_table_statistics'(Mod,PredFunctor)
;
'$do_error'(domain_error(table,Mod:PredName/PredArity),table_statistics(Mod:PredName/PredArity))).
'$do_table_statistics'(Mod,Pred) :-
'$do_error'(type_error(callable,Mod:Pred),table_statistics(Mod:Pred)).