diff --git a/OPTYap/alpha_locks.h b/OPTYap/alpha_locks.h index 2b7eec0f3..7238780df 100644 --- a/OPTYap/alpha_locks.h +++ b/OPTYap/alpha_locks.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: alpha_locks.h - version: $Id: alpha_locks.h,v 1.2 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ------------------------------- ** -** Atomic lock for ALPHA ** -** ------------------------------- */ +/************************************************************************ +** Atomic locks for ALPHA ** +************************************************************************/ /* This code is stolen from the Linux kernel */ diff --git a/OPTYap/alpha_locks_funcs.h b/OPTYap/alpha_locks_funcs.h index fbb8e7d8d..2ec825d1b 100644 --- a/OPTYap/alpha_locks_funcs.h +++ b/OPTYap/alpha_locks_funcs.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: alpha_locks_funcs.h - version: $Id: alpha_locks_funcs.h,v 1.2 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ------------------------------- ** -** Atomic lock for ALPHA ** -** ------------------------------- */ +/************************************************************************ +** Atomic locks for ALPHA ** +************************************************************************/ /* This code is stolen from the Linux kernel */ diff --git a/OPTYap/mips_locks.h b/OPTYap/mips_locks.h index b81e9dd58..790f641f8 100644 --- a/OPTYap/mips_locks.h +++ b/OPTYap/mips_locks.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: mips_locks.h - version: $Id: mips_locks.h,v 1.2 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ------------------------------- ** -** Atomic locking for MIPS ** -** ------------------------------- */ +/************************************************************************ +** Atomic locks for MIPS ** +************************************************************************/ /* This code is stolen from the Linux kernel */ diff --git a/OPTYap/mips_locks_funcs.h b/OPTYap/mips_locks_funcs.h index f1084a576..9f57f36bb 100644 --- a/OPTYap/mips_locks_funcs.h +++ b/OPTYap/mips_locks_funcs.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: mips_locks_funcs.h - version: $Id: mips_locks_funcs.h,v 1.2 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ------------------------------- ** -** Atomic locking for MIPS ** -** ------------------------------- */ +/************************************************************************ +** Atomic locks for MIPS ** +************************************************************************/ static __inline__ int test_and_set_bit(int nr, volatile void *addr) { diff --git a/OPTYap/opt.config.h b/OPTYap/opt.config.h index 41b25cf38..ea43cb14c 100644 --- a/OPTYap/opt.config.h +++ b/OPTYap/opt.config.h @@ -1,124 +1,122 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.config.h - version: $Id: opt.config.h,v 1.10 2005-10-31 12:27:54 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ----------------------------------------------------------------- ** -** General Configuration Parameters ** -** ----------------------------------------------------------------- */ -/* ----------------------------------------------------- ** + +/************************************************************************ +** General Configuration Parameters ** +************************************************************************/ + +/********************************************************** ** memory alloc scheme (mandatory, define one) ** -** ----------------------------------------------------- */ +**********************************************************/ #define YAP_MEMORY_ALLOC_SCHEME 1 /* #define SHM_MEMORY_ALLOC_SCHEME 1 */ /* #define MALLOC_MEMORY_ALLOC_SCHEME 1 */ +/************************************************************************ +** TABLING Configuration Parameters ** +************************************************************************/ - -/* ---------------------------------------------------------------- ** -** TABLING Configuration Parameters ** -** ---------------------------------------------------------------- */ - -/* ----------------------- ** +/**************************** ** default sizes ** -** ----------------------- */ +****************************/ #define MAX_TABLE_VARS 1000 -/* ----------------------------------------------------- ** +/********************************************************** ** trail freeze scheme (mandatory, define one) ** -** ----------------------------------------------------- */ +**********************************************************/ #define BFZ_TRAIL_SCHEME 1 /* #define BBREG_TRAIL_SCHEME 1 */ -/* ----------------------------------------------- ** +/**************************************************** ** support early completion ? (optional) ** -** ----------------------------------------------- */ +****************************************************/ #define TABLING_EARLY_COMPLETION 1 -/* ------------------------------------------------- ** +/****************************************************** ** support trie compact pairs ? (optional) ** -** ------------------------------------------------- */ +******************************************************/ #define TRIE_COMPACT_PAIRS 1 -/* ------------------------------------------------------ ** +/*********************************************************** ** support global trie ? (optional, define one) ** -** ------------------------------------------------------ */ +***********************************************************/ /* #define GLOBAL_TRIE_FOR_CALLS_ANSWERS 1 */ /* #define GLOBAL_TRIE_FOR_TERMS 1 */ /* #define GLOBAL_TRIE_FOR_SUBTERMS 1 */ -/* ---------------------------------------------------- ** -** support deterministic tabling ? (optional) ** -** ---------------------------------------------------- */ -/* #define DETERMINISTIC_TABLING 1 */ - -/* ------------------------------------------------- ** -** limit the table space size ? (optional) ** -** ------------------------------------------------- */ -/* #define LIMIT_TABLING 1 */ - -/* ------------------------------------------------- ** +/****************************************************** ** support incomplete tabling ? (optional) ** -** ------------------------------------------------- */ +******************************************************/ /* #define INCOMPLETE_TABLING 1 */ -/* ----------------------------------------- -- ** +/****************************************************** +** limit the table space size ? (optional) ** +******************************************************/ +/* #define LIMIT_TABLING 1 */ + +/********************************************************* +** support deterministic tabling ? (optional) ** +*********************************************************/ +/* #define DETERMINISTIC_TABLING 1 */ + +/************************************************* ** enable error checking ? (optional) ** -** -------------------------------------------- */ +*************************************************/ /* #define TABLING_ERRORS 1 */ +/************************************************************************ +** YAPOR Configuration Parameters ** +************************************************************************/ - -/* ---------------------------------------------------------------- ** -** YAPOR Configuration Parameters ** -** ---------------------------------------------------------------- */ - -/* ----------------------- ** +/**************************** ** default sizes ** -** ----------------------- */ +****************************/ #define MAX_LENGTH_ANSWER 1000 #define MAX_BRANCH_DEPTH 1000 #define MAX_BEST_TIMES 21 -/* ------------------------------------------------------- ** +/************************************************************ ** memory mapping scheme (mandatory, define one) ** -** ------------------------------------------------------- */ +************************************************************/ #define MMAP_MEMORY_MAPPING_SCHEME 1 /* #define SHM_MEMORY_MAPPING_SCHEME 1 */ -/* -------------------------------------------- ** +/************************************************* ** enable error checking ? (optional) ** -** -------------------------------------------- */ +*************************************************/ /* #define YAPOR_ERRORS 1 */ +/************************************************************************ +** OPTYAP Configuration Parameters ** +************************************************************************/ - -/* ---------------------------------------------------------------- ** -** OPTYAP Configuration Parameters ** -** ---------------------------------------------------------------- */ - -/* ----------------------- ** +/**************************** ** default sizes ** -** ----------------------- */ +****************************/ #define TABLE_LOCK_BUCKETS 512 #define TG_ANSWER_SLOTS 20 -/* ------------------------------------------------------ ** +/*********************************************************** ** tries locking scheme (mandatory, define one) ** -** ------------------------------------------------------ ** +************************************************************ ** 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 operations needed to go ** @@ -134,29 +132,27 @@ ** is going to update it. You can use ALLOC_BEFORE_CHECK ** ** with this scheme to allocate a node before checking ** ** if it will be necessary. ** -** ------------------------------------------------------ */ +***********************************************************/ /* #define TABLE_LOCK_AT_ENTRY_LEVEL 1 */ /* #define TABLE_LOCK_AT_NODE_LEVEL 1 */ #define TABLE_LOCK_AT_WRITE_LEVEL 1 /* #define ALLOC_BEFORE_CHECK 1 */ -/* ----------------------------------------- ** +/********************************************** ** support inner cuts ? (optional) ** -** ----------------------------------------- */ +**********************************************/ #define TABLING_INNER_CUTS 1 -/* ---------------------------------------------------- ** +/********************************************************* ** use timestamps for suspension ? (optional) ** -** ---------------------------------------------------- */ +*********************************************************/ #define TIMESTAMP_CHECK 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 diff --git a/OPTYap/opt.init.c b/OPTYap/opt.init.c index 80d9dd5b2..257c862e0 100644 --- a/OPTYap/opt.init.c +++ b/OPTYap/opt.init.c @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.init.c - version: $Id: opt.init.c,v 1.16 2008-04-11 16:26:18 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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) @@ -42,9 +44,9 @@ ma_h_inner_struct *Yap_ma_h_top; -/* ---------------------- ** -** Local macros ** -** ---------------------- */ +/********************* +** Macros ** +*********************/ #ifdef SHM_MEMORY_ALLOC_SCHEME #define STRUCTS_PER_PAGE(STR_TYPE) ((Yap_page_size - STRUCT_SIZE(struct page_header)) / STRUCT_SIZE(STR_TYPE)) @@ -61,9 +63,9 @@ ma_h_inner_struct *Yap_ma_h_top; -/* -------------------------- ** +/******************************* ** Global functions ** -** -------------------------- */ +*******************************/ void Yap_init_global(int max_table_size, int n_workers, int sch_loop, int delay_load) { int i; diff --git a/OPTYap/opt.macros.h b/OPTYap/opt.macros.h index f52595e2e..7e9b2c46f 100644 --- a/OPTYap/opt.macros.h +++ b/OPTYap/opt.macros.h @@ -1,32 +1,27 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.macros.h - version: $Id: opt.macros.h,v 1.12 2007-04-26 14:11:08 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 and defines ** -** ------------------------------ */ +/******************************** +** Memory management ** +********************************/ #ifdef SHM_MEMORY_ALLOC_SCHEME #include - #define SHMMAX 0x2000000 /* 32 Mbytes: works fine with linux */ /* #define SHMMAX 0x400000 - 4 Mbytes: shmget limit for Mac (?) */ /* #define SHMMAX 0x800000 - 8 Mbytes: shmget limit for Solaris (?) */ #endif /* SHM_MEMORY_ALLOC_SCHEME */ - - -/* --------------------------- ** -** Memory management ** -** --------------------------- */ - extern int Yap_page_size; #if SIZEOF_INT_P == 4 @@ -48,7 +43,7 @@ extern int Yap_page_size; #define UPDATE_STATS(STAT, VALUE) STAT += VALUE -#ifdef MALLOC_MEMORY_ALLOC_SCHEME /* ---------------------------------------------------------------- */ +#ifdef MALLOC_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) \ @@ -58,7 +53,7 @@ extern int Yap_page_size; #define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \ free(STR) -#elif YAP_MEMORY_ALLOC_SCHEME /* -------------------------------------------------------------------- */ +#elif YAP_MEMORY_ALLOC_SCHEME /************************************************************************/ #define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \ { char *ptr = Yap_AllocCodeSpace(sizeof(STR_TYPE) + sizeof(CELL)); \ if (ptr) { \ @@ -88,7 +83,7 @@ extern int Yap_page_size; free(ptr); \ UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \ } -#elif SHM_MEMORY_ALLOC_SCHEME /* -------------------------------------------------------------------- */ +#elif SHM_MEMORY_ALLOC_SCHEME /************************************************************************/ #ifdef LIMIT_TABLING #define INIT_PAGE(PG_HD, STR_PAGES, STR_TYPE) \ { int i; \ @@ -353,9 +348,7 @@ extern int Yap_page_size; UNLOCK(Pg_lock(STR_PAGES)); \ } \ } -#endif /* --------------------------- MEMORY_ALLOC_SCHEME -------------------------------------------- */ - - +#endif /************************************************************************************************/ #ifdef YAPOR #define ALLOC_BLOCK(BLOCK, SIZE) \ @@ -432,9 +425,9 @@ extern int Yap_page_size; -/* ------------------------------------- ** +/****************************************** ** Bitmap tests and operations ** -** ------------------------------------- */ +******************************************/ #define BITMAP_empty(b) ((b) == 0) #define BITMAP_member(b,n) (((b) & (1<<(n))) != 0) @@ -453,9 +446,9 @@ extern int Yap_page_size; -/* ---------------------------------- ** +/*************************************** ** Message and debug macros ** -** ---------------------------------- */ +***************************************/ #define INFORMATION_MESSAGE(MESG, ARGS...) information_message(MESG, ##ARGS) @@ -476,54 +469,3 @@ extern int Yap_page_size; #else #define OPTYAP_ERROR_MESSAGE(MESG, ARGS...) #endif /* OPTYAP_ERRORS */ - - - -/* ----------------------- ** -** SimICS macros ** -** ----------------------- */ - -/* -** Counter 0. Total time -** Counter 1. Prolog -** Counter 2. P Share -** Counter 3. Scheduler -** Counter 4. Cut request -** Counter 5. End operations -** Counter 6. Cut shared (Counter 1 or 3 or 5) -** Counter 7. Number of requests to share work (Counter 3) -** Counter 8. Number of refused requests (Counter 3) -** Counter 9. Number of tasks (Counter 1) -** Counter 10. Number of calls (Counter 1) -** Counter 11. Number of failed TRY_LOCK's -*/ - -#define START_COUNTER 1 -#define STOP_COUNTER 2 - -#define TOTAL_TIME 0 -#define PROLOG 1 -#define SHARE 2 -#define SCHEDULER 3 -#define CUT_REQUEST 4 -#define END_OPERATIONS 5 -#define CUT_SHARED 6 -#define ONE_MORE_REQUEST 7 -#define ONE_MORE_REFUSED_REQUEST 8 -#define ONE_MORE_TASK 9 -#define ONE_MORE_CALL 10 - -#ifdef SIMICS -#define SIMICS_ATOMIC_SERVICE(COUNTER) \ - SIMICS_SERVICE(START_COUNTER, COUNTER); \ - SIMICS_SERVICE(STOP_COUNTER, COUNTER) -#define SIMICS_SERVICE(COMMAND, COUNTER) \ - do { \ - asm volatile ("sethi %0, %%g0" : \ - /* no outputs */ : \ - "g" ((COMMAND << 16) | COUNTER)); \ - } while(0) -#else -#define SIMICS_ATOMIC_SERVICE(COUNTER) -#define SIMICS_SERVICE(COMMAND, COUNTER) -#endif /* SIMICS */ diff --git a/OPTYap/opt.mavar.h b/OPTYap/opt.mavar.h index 0b2c49b32..0613590f7 100644 --- a/OPTYap/opt.mavar.h +++ b/OPTYap/opt.mavar.h @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.mavar.h - version: $Id: opt.mavar.h,v 1.4 2005-08-05 14:55:03 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ #ifdef MULTI_ASSIGNMENT_VARIABLES /* diff --git a/OPTYap/opt.memory.c b/OPTYap/opt.memory.c index 3df93809c..344f238f4 100644 --- a/OPTYap/opt.memory.c +++ b/OPTYap/opt.memory.c @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.memory.c - version: $Id: opt.memory.c,v 1.10 2008-03-25 16:45:53 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 and local variables ** -** -------------------------------------- */ +/************************************** +** Includes & Declarations ** +**************************************/ #include "Yap.h" #if defined(YAPOR) && !defined(THREADS) @@ -39,9 +41,9 @@ int shm_mapid[MAX_WORKERS + 1]; -/* --------------------------- ** +/******************************** ** Global functions ** -** --------------------------- */ +********************************/ #ifdef SHM_MEMORY_MAPPING_SCHEME void shm_map_memory(int id, int size, void *shmaddr) { diff --git a/OPTYap/opt.misc.c b/OPTYap/opt.misc.c index 639655607..d5e029604 100644 --- a/OPTYap/opt.misc.c +++ b/OPTYap/opt.misc.c @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.misc.c - version: $Id: opt.misc.c,v 1.11 2005-06-03 18:28:11 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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) @@ -29,20 +31,21 @@ -/* ------------------------------------------- ** +/************************************************ ** Global variables are defined here ** -** ------------------------------------------- */ +************************************************/ #ifndef THREADS #ifdef YAPOR struct worker WORKER; #endif /* YAPOR */ -#endif +#endif /* ! THREADS */ -/* -------------------------- ** + +/******************************* ** Global functions ** -** -------------------------- */ +*******************************/ void itos(int i, char *s) { int n,r,j; diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index 26b0ecc88..a384a34c1 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.preds.c - version: $Id: opt.preds.c,v 1.29 2008/04/11 16:26:19 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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, defines and local variables ** -** ----------------------------------------------- */ +/************************************ +** Includes & Prototypes ** +************************************/ #include "Yap.h" #if defined(YAPOR) || defined(TABLING) @@ -32,20 +34,6 @@ #include "tab.macros.h" #endif /* TABLING */ -#ifdef YAPOR -#define TIME_RESOLUTION 1000000 -#define NO_ANSWER 0 -#define YES_ANSWER -1 -static int length_answer; -static qg_ans_fr_ptr actual_answer; -#endif /* YAPOR */ - - - -/* ------------------------------------- ** -** Local functions declaration ** -** ------------------------------------- */ - static Int p_yapor_threads(void); #ifdef YAPOR static realtime current_time(void); @@ -121,13 +109,27 @@ static void shm_suspension_frames(long *pages_in_use, long *bytes_in_use); -/* -------------------------- ** +/************************************ +** Macros & Declarations ** +************************************/ + +#ifdef YAPOR +#define TIME_RESOLUTION 1000000 +#define NO_ANSWER 0 +#define YES_ANSWER -1 +static int length_answer; +static qg_ans_fr_ptr actual_answer; +#endif /* YAPOR */ + + + +/******************************* ** Global functions ** -** -------------------------- */ +*******************************/ void Yap_init_optyap_preds(void) { -#ifdef YAPOR Yap_InitCPred("$yapor_threads", 1, p_yapor_threads, SafePredFlag|SyncPredFlag|HiddenPredFlag); +#ifdef YAPOR Yap_InitCPred("$worker", 0, p_worker, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$yapor_on", 0, p_yapor_on, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$start_yapor", 0, p_start_yapor, SafePredFlag|SyncPredFlag|HiddenPredFlag); @@ -175,9 +177,9 @@ void finish_yapor(void) { -/* ------------------------- ** +/****************************** ** Local functions ** -** ------------------------- */ +******************************/ static Int p_yapor_threads(void) { diff --git a/OPTYap/opt.proto.h b/OPTYap/opt.proto.h index 37b61e7a5..8e844490a 100644 --- a/OPTYap/opt.proto.h +++ b/OPTYap/opt.proto.h @@ -1,47 +1,51 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.proto.h - version: $Id: opt.proto.h,v 1.12 2005-11-04 01:17:17 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* -------------- ** -** opt.memory.c ** -** -------------- */ +/*************************** +** opt.memory.c ** +***************************/ #ifdef YAPOR #ifdef SHM_MEMORY_MAPPING_SCHEME -void shm_map_memory(int id, int size, void *shmaddr); +void shm_map_memory(int, int, void *); #else /* MMAP_MEMORY_MAPPING_SCHEME */ void open_mapfile(long); void close_mapfile(void); #endif /* MEMORY_MAPPING_SCHEME */ -void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_workers); +void map_memory(long, long, long, int); void unmap_memory(void); void remap_memory(void); #endif /* YAPOR */ -/* ------------ ** -** opt.misc.c ** -** ------------ */ -void itos(int i, char *s); -void information_message(const char *mesg,...); +/************************* +** opt.misc.c ** +*************************/ + +void itos(int, char *); +void information_message(const char *,...); #if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS) -void error_message(const char *mesg, ...); +void error_message(const char *, ...); #endif /* YAPOR_ERRORS || TABLING_ERRORS */ -/* ------------ ** -** opt.init.c ** -** ------------ */ -void Yap_init_global(int max_table_size, int n_workers, int sch_loop, int delay_load); +/************************* +** opt.init.c ** +*************************/ + +void Yap_init_global(int, int, int, int); void Yap_init_local(void); void make_root_frames(void); #ifdef YAPOR @@ -49,56 +53,58 @@ void init_workers(void); #endif /* YAPOR */ -/* ------------- ** -** opt.preds.c ** -** ------------- */ + +/************************** +** opt.preds.c ** +**************************/ #ifdef YAPOR void finish_yapor(void); #endif /* YAPOR */ -/* ------------- ** -** tab.tries.c ** -** ------------- */ + +/************************** +** tab.tries.c ** +**************************/ #ifdef TABLING -sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr); -ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr); -void load_answer(ans_node_ptr ans_node, CELL *subs_ptr); -#ifdef GLOBAL_TRIE -CELL *load_substitution_variable(gt_node_ptr current_node, CELL *aux_stack_ptr); +sg_fr_ptr subgoal_search(yamop *, CELL **); +ans_node_ptr answer_search(sg_fr_ptr, CELL *); +void load_answer(ans_node_ptr, CELL *); +#ifndef GLOBAL_TRIE +void free_subgoal_trie_branch(sg_node_ptr, int, int, int); +#else /* GLOBAL_TRIE */ +CELL *load_substitution_variable(gt_node_ptr, CELL *); +void free_subgoal_trie_branch(sg_node_ptr, int, int); #endif /* GLOBAL_TRIE */ -void private_completion(sg_fr_ptr sg_fr); -#ifdef GLOBAL_TRIE -void free_subgoal_trie_branch(sg_node_ptr node, int nodes_left, int position); -#else -void free_subgoal_trie_branch(sg_node_ptr node, int nodes_left, int nodes_extra, int position); -#endif /* GLOBAL_TRIE */ -void free_answer_trie_branch(ans_node_ptr node, int position); -void update_answer_trie(sg_fr_ptr sg_fr); -void show_table(tab_ent_ptr tab_ent, int show_mode); +void free_answer_trie_branch(ans_node_ptr, int); +void update_answer_trie(sg_fr_ptr); +void show_table(tab_ent_ptr, int); #ifdef GLOBAL_TRIE void show_global_trie(void); #endif /* GLOBAL_TRIE */ +void private_completion(sg_fr_ptr); #endif /* TABLING */ -/* --------------- ** -** tab.suspend.c ** -** --------------- */ + +/**************************** +** tab.suspend.c ** +****************************/ #if defined(TABLING) && defined(YAPOR) void public_completion(void); -void complete_suspension_frames(or_fr_ptr or_fr); +void complete_suspension_frames(or_fr_ptr); void suspend_branch(void); -void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr); +void resume_suspension_frame(susp_fr_ptr, or_fr_ptr); #endif /* TABLING && YAPOR */ -/* ------------- ** -** or.*engine.c ** -** ------------- */ + +/************************** +** or.engine.c ** +**************************/ #ifdef YAPOR void make_root_choice_point(void); @@ -107,19 +113,22 @@ int q_share_work(int p); int p_share_work(void); #endif /* YAPOR */ -/* ---------------- ** -** or.scheduler.c ** -** ---------------- */ + + +/***************************** +** or.scheduler.c ** +*****************************/ #ifdef YAPOR int get_work(void); #endif /* YAPOR */ -/* ---------- ** -** or.cut.c ** -** ---------- */ + +/*********************** +** or.cut.c ** +***********************/ #ifdef YAPOR -void prune_shared_branch(choiceptr prune_cp); +void prune_shared_branch(choiceptr); #endif /* YAPOR */ diff --git a/OPTYap/opt.structs.h b/OPTYap/opt.structs.h index 59caf4d4a..37f37904c 100644 --- a/OPTYap/opt.structs.h +++ b/OPTYap/opt.structs.h @@ -1,22 +1,23 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: opt.structs.h - version: $Id: opt.structs.h,v 1.11 2007-04-26 14:11:08 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ----------------- ** +/********************** ** Typedefs ** -** ----------------- */ +**********************/ typedef double realtime; typedef unsigned long bitmap; - #ifdef THREADS /* Threads may not assume addresses are the same at different workers */ static inline choiceptr @@ -44,12 +45,13 @@ cptr_to_offset_with_null(choiceptr node) if (node == NULL) return 0L; return (Int)((CELL *)node-LCL0); } +#endif /* THREADS */ -#endif -/* ---------------------------- ** + +/********************************* ** Struct page_header ** -** ---------------------------- */ +*********************************/ typedef struct page_header { volatile int structs_in_use; @@ -65,9 +67,9 @@ typedef struct page_header { -/* ---------------------- ** +/*************************** ** Struct pages ** -** ---------------------- */ +***************************/ struct pages { #ifdef SHM_MEMORY_ALLOC_SCHEME @@ -90,9 +92,9 @@ struct pages { -/* ----------------------------- ** +/********************************** ** Struct global_pages ** -** ----------------------------- */ +**********************************/ struct global_pages { #ifdef LIMIT_TABLING @@ -128,9 +130,9 @@ struct global_pages { -/* ----------------------------- ** +/********************************** ** Struct global_locks ** -** ----------------------------- */ +**********************************/ #ifdef YAPOR struct global_locks { @@ -155,9 +157,9 @@ struct global_locks { -/* ---------------------------- ** +/********************************* ** Struct global_data ** -** ---------------------------- */ +*********************************/ struct global_data{ /* global data related to memory management */ @@ -294,9 +296,9 @@ struct global_data{ -/* ------------------------------ ** +/*********************************** ** Struct local_signals ** -** ------------------------------ */ +***********************************/ #ifdef YAPOR struct local_signals{ @@ -322,9 +324,9 @@ struct local_signals{ -/* --------------------------- ** +/******************************** ** Struct local_data ** -** --------------------------- */ +********************************/ struct local_data{ #if defined(YAPOR) || defined(THREADS) diff --git a/OPTYap/or.cowengine.c b/OPTYap/or.cowengine.c index 4bf967cb0..5486ca6f9 100644 --- a/OPTYap/or.cowengine.c +++ b/OPTYap/or.cowengine.c @@ -1,19 +1,15 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: or.cowengine.c * -* Last rev: * -* mods: * -* comments: * -* * -*************************************************************************/ +/************************************************************************ +** ** +** 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 ** diff --git a/OPTYap/or.cut.c b/OPTYap/or.cut.c index 6ca6a2988..76aecb450 100644 --- a/OPTYap/or.cut.c +++ b/OPTYap/or.cut.c @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: or.cut.c - version: $Id: or.cut.c,v 1.3 2008-03-25 16:45:53 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** diff --git a/OPTYap/or.engine.c b/OPTYap/or.engine.c index f0ac8a2d7..3ed6d4fa6 100644 --- a/OPTYap/or.engine.c +++ b/OPTYap/or.engine.c @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: or.engine.c - version: $Id: or.engine.c,v 1.11 2008-03-25 16:45:53 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** @@ -464,7 +466,7 @@ void share_private_nodes(int worker_q) { choiceptr consumer_cp, next_node_on_branch; dep_fr_ptr dep_frame; sg_fr_ptr sg_frame; - CELL *stack, *stack_base, *stack_limit; + CELL *stack, *stack_limit; /* find top dependency frame above current choice point */ dep_frame = LOCAL_top_dep_fr; @@ -475,7 +477,7 @@ void share_private_nodes(int worker_q) { consumer_cp = DepFr_cons_cp(dep_frame); next_node_on_branch = NULL; stack_limit = (CELL *)TR; - stack_base = stack = (CELL *)Yap_TrailTop; + stack = (CELL *)Yap_TrailTop; #endif /* TABLING */ /* initialize auxiliary variables */ @@ -564,9 +566,9 @@ void share_private_nodes(int worker_q) { if (! next_node_on_branch) next_node_on_branch = sharing_node; STACK_PUSH_UP(or_frame, stack); - STACK_CHECK_EXPAND1(stack, stack_limit, stack_base); + STACK_CHECK_EXPAND(stack, stack_limit); STACK_PUSH(sharing_node, stack); - STACK_CHECK_EXPAND1(stack, stack_limit, stack_base); + STACK_CHECK_EXPAND(stack, stack_limit); sharing_node = consumer_cp; dep_frame = DepFr_next(dep_frame); consumer_cp = DepFr_cons_cp(dep_frame); @@ -594,7 +596,7 @@ void share_private_nodes(int worker_q) { #ifdef TABLING /* update or-frames stored in auxiliary stack */ - while (STACK_NOT_EMPTY(stack, stack_base)) { + while (STACK_NOT_EMPTY(stack, (CELL *)Yap_TrailTop)) { next_node_on_branch = (choiceptr) STACK_POP_DOWN(stack); or_frame = (or_fr_ptr) STACK_POP_DOWN(stack); OrFr_nearest_livenode(or_frame) = OrFr_next(or_frame) = next_node_on_branch->cp_or_fr; diff --git a/OPTYap/or.insts.i b/OPTYap/or.insts.i index 424d34b8d..e918e75cd 100644 --- a/OPTYap/or.insts.i +++ b/OPTYap/or.insts.i @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: or.insts.i - version: $Id: or.insts.i,v 1.4 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ /* -------------------------------- ** ** Scheduler instructions ** diff --git a/OPTYap/or.macros.h b/OPTYap/or.macros.h index 0b2b3f451..78492478d 100644 --- a/OPTYap/or.macros.h +++ b/OPTYap/or.macros.h @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: or.macros.h - version: $Id: or.macros.h,v 1.5 2008-03-25 16:45:53 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ /* -------------------- ** ** Prototypes ** diff --git a/OPTYap/or.sbaengine.c b/OPTYap/or.sbaengine.c index 36c686e5c..30564b464 100644 --- a/OPTYap/or.sbaengine.c +++ b/OPTYap/or.sbaengine.c @@ -1,19 +1,15 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: or.sbaengine.c * -* Last rev: * -* mods: * -* comments: * -* * -*************************************************************************/ +/************************************************************************ +** ** +** 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 ** diff --git a/OPTYap/or.scheduler.c b/OPTYap/or.scheduler.c index f34bc4fd7..eff27e5a4 100644 --- a/OPTYap/or.scheduler.c +++ b/OPTYap/or.scheduler.c @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: or.scheduler.c - version: $Id: or.scheduler.c,v 1.4 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** diff --git a/OPTYap/or.structs.h b/OPTYap/or.structs.h index 906221e8c..9af870c74 100644 --- a/OPTYap/or.structs.h +++ b/OPTYap/or.structs.h @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: or.structs.h - version: $Id: or.structs.h,v 1.3 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ /* ----------------------- ** ** Struct worker ** diff --git a/OPTYap/or.threadengine.c b/OPTYap/or.threadengine.c index 62dc5774f..b2fbc8a77 100644 --- a/OPTYap/or.threadengine.c +++ b/OPTYap/or.threadengine.c @@ -1,13 +1,15 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: or.threadengine.c - version: $Id: or.engine.c,v 1.11 2008-03-25 16:45:53 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** @@ -290,7 +292,7 @@ void share_private_nodes(int worker_q) { choiceptr consumer_cp, next_node_on_branch; dep_fr_ptr dep_frame; sg_fr_ptr sg_frame; - CELL *stack, *stack_base, *stack_limit; + CELL *stack, *stack_limit; /* find top dependency frame above current choice point */ dep_frame = LOCAL_top_dep_fr; @@ -301,7 +303,7 @@ void share_private_nodes(int worker_q) { consumer_cp = DepFr_cons_cp(dep_frame); next_node_on_branch = NULL; stack_limit = (CELL *)TR; - stack_base = stack = (CELL *)Yap_TrailTop; + stack = (CELL *)Yap_TrailTop; #endif /* TABLING */ /* initialize auxiliary variables */ @@ -390,9 +392,9 @@ void share_private_nodes(int worker_q) { if (! next_node_on_branch) next_node_on_branch = sharing_node; STACK_PUSH_UP(or_frame, stack); - STACK_CHECK_EXPAND1(stack, stack_limit, stack_base); + STACK_CHECK_EXPAND(stack, stack_limit); STACK_PUSH_UP(sharing_node, stack); /* vsc: STACK_PUSH -> STACK_PUSH_UP? */ - STACK_CHECK_EXPAND1(stack, stack_limit, stack_base); + STACK_CHECK_EXPAND(stack, stack_limit); sharing_node = consumer_cp; dep_frame = DepFr_next(dep_frame); consumer_cp = DepFr_cons_cp(dep_frame); @@ -420,7 +422,7 @@ void share_private_nodes(int worker_q) { #ifdef TABLING /* update or-frames stored in auxiliary stack */ - while (STACK_NOT_EMPTY(stack, stack_base)) { + while (STACK_NOT_EMPTY(stack, (CELL *)Yap_TrailTop)) { next_node_on_branch = (choiceptr) STACK_POP_DOWN(stack); or_frame = (or_fr_ptr) STACK_POP_DOWN(stack); OrFr_nearest_livenode(or_frame) = OrFr_next(or_frame) = next_node_on_branch->cp_or_fr; diff --git a/OPTYap/pthread_locks.h b/OPTYap/pthread_locks.h index 2fdc22ec5..2924b9adc 100644 --- a/OPTYap/pthread_locks.h +++ b/OPTYap/pthread_locks.h @@ -1,26 +1,22 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: pthread_locks.h * -* Last rev: * -* mods: * -* comments: * -* * -*************************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ + +/* ********************************************************************** +** Atomic locks for PTHREADS ** +************************************************************************/ #include -/* ----------------------------------- ** -** Atomic locks for PTHREADS ** -** ----------------------------------- */ - #define INIT_LOCK(LOCK_VAR) pthread_mutex_init(&(LOCK_VAR), NULL) #define DESTROY_LOCK(LOCK_VAR) pthread_mutex_destroy(&(LOCK_VAR)) #define TRY_LOCK(LOCK_PTR) pthread_mutex_trylock(&(LOCK_VAR)) diff --git a/OPTYap/sbaamiops.h b/OPTYap/sbaamiops.h index 273d5641e..7d534b8b8 100644 --- a/OPTYap/sbaamiops.h +++ b/OPTYap/sbaamiops.h @@ -1,21 +1,15 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: sbaamiops.h * -* Last rev: * -* mods: * -* comments: Basic abstract machine operations, such as * -* dereferencing, binding, trailing, and unification * -* in the SBA model. * -* * -*************************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; diff --git a/OPTYap/sbaunify.h b/OPTYap/sbaunify.h index ce2ed7df2..b2bcf8362 100644 --- a/OPTYap/sbaunify.h +++ b/OPTYap/sbaunify.h @@ -1,21 +1,15 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: sbaunify.h * -* Last rev: * -* mods: * -* comments: Basic abstract machine operations, such as * -* dereferencing, binding, trailing, and unification * -* in the SBA model. * -* * -*************************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; diff --git a/OPTYap/sparc_locks.h b/OPTYap/sparc_locks.h index 38927213f..bc4090c30 100644 --- a/OPTYap/sparc_locks.h +++ b/OPTYap/sparc_locks.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: sparc_locks.h - version: $Id: sparc_locks.h,v 1.3 2005-05-31 08:24:24 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ------------------------------- ** -** Atomic lock for SPARC ** -** ------------------------------- */ +/************************************************************************ +** Atomic locks for SPARC ** +************************************************************************/ #define swap_il(adr,reg) \ ({ int _ret; \ diff --git a/OPTYap/tab.insts.i b/OPTYap/tab.insts.i index 79ba06aea..326ad98f4 100644 --- a/OPTYap/tab.insts.i +++ b/OPTYap/tab.insts.i @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: tab.insts.i - version: $Id: tab.insts.i,v 1.26 2008-05-23 18:28:58 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ------------------------------------------------ ** -** Tabling instructions: auxiliary macros ** -** ------------------------------------------------ */ +/************************************************************************ +** Tabling instructions: auxiliary macros ** +************************************************************************/ #ifdef LOW_LEVEL_TRACER #define store_low_level_trace_info(CP, TAB_ENT) CP->cp_pred_entry = TabEnt_pe(TAB_ENT) @@ -277,9 +279,9 @@ -/* ------------------------------ ** -** Tabling instructions ** -** ------------------------------ */ +/************************************************************************ +** clause_with_cut ** +************************************************************************/ #ifdef TABLING_INNER_CUTS Op(clause_with_cut, e) @@ -297,6 +299,10 @@ +/************************************************************************ +** table_load_answer ** +************************************************************************/ + PBOp(table_load_answer, Otapl) CELL *subs_ptr; ans_node_ptr ans_node; @@ -329,6 +335,10 @@ +/************************************************************************ +** table_try_answer ** +************************************************************************/ + PBOp(table_try_answer, Otapl) #ifdef INCOMPLETE_TABLING sg_fr_ptr sg_fr; @@ -388,6 +398,10 @@ +/************************************************************************ +** table_try_single ** +************************************************************************/ + PBOp(table_try_single, Otapl) tab_ent_ptr tab_ent; sg_fr_ptr sg_fr; @@ -506,6 +520,10 @@ +/************************************************************************ +** table_try_me ** +************************************************************************/ + PBOp(table_try_me, Otapl) tab_ent_ptr tab_ent; sg_fr_ptr sg_fr; @@ -617,6 +635,10 @@ +/************************************************************************ +** table_try ** +************************************************************************/ + PBOp(table_try, Otapl) tab_ent_ptr tab_ent; sg_fr_ptr sg_fr; @@ -728,6 +750,10 @@ +/************************************************************************ +** table_retry_me ** +************************************************************************/ + Op(table_retry_me, Otapl) restore_generator_node(PREG->u.Otapl.s, PREG->u.Otapl.d); YENV = (CELL *) PROTECT_FROZEN_B(B); @@ -740,6 +766,10 @@ +/************************************************************************ +** table_retry ** +************************************************************************/ + Op(table_retry, Otapl) restore_generator_node(PREG->u.Otapl.s, NEXTOP(PREG,Otapl)); YENV = (CELL *) PROTECT_FROZEN_B(B); @@ -752,6 +782,10 @@ +/************************************************************************ +** table_trust_me ** +************************************************************************/ + Op(table_trust_me, Otapl) restore_generator_node(PREG->u.Otapl.s, COMPLETION); #ifdef DETERMINISTIC_TABLING @@ -780,6 +814,10 @@ +/************************************************************************ +** table_trust ** +************************************************************************/ + Op(table_trust, Otapl) restore_generator_node(PREG->u.Otapl.s, COMPLETION); #ifdef DETERMINISTIC_TABLING @@ -808,6 +846,10 @@ +/************************************************************************ +** table_new_answer ** +************************************************************************/ + PBOp(table_new_answer, s) CELL *subs_ptr; choiceptr gcp; @@ -1063,6 +1105,10 @@ +/************************************************************************ +** table_answer_resolution ** +************************************************************************/ + BOp(table_answer_resolution, Otapl) #ifdef YAPOR if (SCH_top_shared_cp(B)) { @@ -1349,6 +1395,10 @@ +/************************************************************************ +** table_completion ** +************************************************************************/ + BOp(table_completion, Otapl) #ifdef YAPOR if (SCH_top_shared_cp(B)) { diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h index da22d394f..dc8a943ef 100644 --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: tab.macros.h - version: $Id: tab.macros.h,v 1.22 2008-05-23 18:28:58 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** -** ------------------ */ +/************************************ +** Includes & Prototypes ** +************************************/ #include #if HAVE_STRING_H @@ -19,51 +21,44 @@ #endif #include "opt.mavar.h" - - -/* -------------------- ** -** Prototypes ** -** -------------------- */ - -STD_PROTO(static inline void adjust_freeze_registers, (void)); -STD_PROTO(static inline void mark_as_completed, (sg_fr_ptr)); -STD_PROTO(static inline void unbind_variables, (tr_fr_ptr, tr_fr_ptr)); -STD_PROTO(static inline void rebind_variables, (tr_fr_ptr, tr_fr_ptr)); -STD_PROTO(static inline void restore_bindings, (tr_fr_ptr, tr_fr_ptr)); -STD_PROTO(static inline void abolish_incomplete_subgoals, (choiceptr)); -STD_PROTO(static inline void free_subgoal_trie_hash_chain, (sg_hash_ptr)); -STD_PROTO(static inline void free_answer_trie_hash_chain, (ans_hash_ptr)); -STD_PROTO(static inline choiceptr freeze_current_cp, (void)); -STD_PROTO(static inline void resume_frozen_cp, (choiceptr)); -STD_PROTO(static inline void abolish_all_frozen_cps, (void)); - +static inline CELL *expand_auxiliary_stack(CELL *); +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 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 -STD_PROTO(static inline void pruning_over_tabling_data_structures, (void)); -STD_PROTO(static inline void collect_suspension_frames, (or_fr_ptr)); +static inline void pruning_over_tabling_data_structures(void); +static inline void collect_suspension_frames(or_fr_ptr); #ifdef TIMESTAMP_CHECK -STD_PROTO(static inline susp_fr_ptr suspension_frame_to_resume, (or_fr_ptr, long)); +static inline susp_fr_ptr suspension_frame_to_resume(or_fr_ptr, long); #else -STD_PROTO(static inline susp_fr_ptr suspension_frame_to_resume, (or_fr_ptr)); +static inline susp_fr_ptr suspension_frame_to_resume(or_fr_ptr); #endif /* TIMESTAMP_CHECK */ #endif /* YAPOR */ - #ifdef TABLING_INNER_CUTS -STD_PROTO(static inline void CUT_store_tg_answer, (or_fr_ptr, ans_node_ptr, choiceptr, int)); -STD_PROTO(static inline tg_sol_fr_ptr CUT_store_tg_answers, (or_fr_ptr, tg_sol_fr_ptr, int)); -STD_PROTO(static inline void CUT_validate_tg_answers, (tg_sol_fr_ptr)); -STD_PROTO(static inline void CUT_join_tg_solutions, (tg_sol_fr_ptr *, tg_sol_fr_ptr)); -STD_PROTO(static inline void CUT_join_solution_frame_tg_answers, (tg_sol_fr_ptr)); -STD_PROTO(static inline void CUT_join_solution_frames_tg_answers, (tg_sol_fr_ptr)); -STD_PROTO(static inline void CUT_free_tg_solution_frame, (tg_sol_fr_ptr)); -STD_PROTO(static inline void CUT_free_tg_solution_frames, (tg_sol_fr_ptr)); -STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_ptr, int)); +static inline void CUT_store_tg_answer(or_fr_ptr, ans_node_ptr, choiceptr, int); +static inline tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr, tg_sol_fr_ptr, int); +static inline void CUT_validate_tg_answers(tg_sol_fr_ptr); +static inline void CUT_join_tg_solutions(tg_sol_fr_ptr *, tg_sol_fr_ptr); +static inline void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr); +static inline void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr); +static inline void CUT_free_tg_solution_frame(tg_sol_fr_ptr); +static inline void CUT_free_tg_solution_frames(tg_sol_fr_ptr); +static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int); #endif /* TABLING_INNER_CUTS */ -/* ----------------- ** -** Defines ** -** ----------------- */ +/********************* +** Macros ** +*********************/ #define SHOW_MODE_STRUCTURE 0 #define SHOW_MODE_STATISTICS 1 @@ -80,11 +75,21 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p #define TRAVERSE_POSITION_FIRST 1 #define TRAVERSE_POSITION_LAST 2 - - -/* ----------------------- ** -** Tabling Macros ** -** ----------------------- */ +/* LowTagBits is 3 for 32 bit-machines and 7 for 64 bit-machines */ +#define NumberOfLowTagBits (LowTagBits == 3 ? 2 : 3) +#define MakeTableVarTerm(INDEX) ((INDEX) << NumberOfLowTagBits) +#define VarIndexOfTableTerm(TERM) (((unsigned int) (TERM)) >> NumberOfLowTagBits) +#define VarIndexOfTerm(TERM) \ + ((((CELL) (TERM)) - GLOBAL_table_var_enumerator(0)) / sizeof(CELL)) +#define IsTableVarTerm(TERM) \ + ((CELL) (TERM)) >= GLOBAL_table_var_enumerator(0) && \ + ((CELL) (TERM)) <= GLOBAL_table_var_enumerator(MAX_TABLE_VARS - 1) +#ifdef TRIE_COMPACT_PAIRS +#define PairTermMark NULL +#define CompactPairInit AbsPair((Term *) 0) +#define CompactPairEndTerm AbsPair((Term *) (LowTagBits + 1)) +#define CompactPairEndList AbsPair((Term *) (2*(LowTagBits + 1))) +#endif /* TRIE_COMPACT_PAIRS */ #define NORM_CP(CP) ((choiceptr)(CP)) #define GEN_CP(CP) ((struct generator_choicept *)(CP)) @@ -99,89 +104,42 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p #define IS_BATCHED_GEN_CP(CP) (GEN_CP(CP)->cp_dep_fr == NULL) #endif /* DETERMINISTIC_TABLING */ +#define TAG_AS_ANSWER_LEAF_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((unsigned long int) TrNode_parent(NODE) | 0x1) +#define UNTAG_ANSWER_LEAF_NODE(NODE) ((ans_node_ptr)((unsigned long int) (NODE) & ~(0x1))) +#define IS_ANSWER_LEAF_NODE(NODE) ((unsigned long int) TrNode_parent(NODE) & 0x1) -#define STACK_NOT_EMPTY(STACK, STACK_BASE) STACK != STACK_BASE -#define STACK_PUSH_UP(ITEM, STACK) *--STACK = (CELL)(ITEM) -#define STACK_POP_DOWN(STACK) *STACK++ -#define STACK_PUSH_DOWN(ITEM, STACK) *STACK++ = (CELL)(ITEM) -#define STACK_POP_UP(STACK) *--STACK -#ifdef YAPOR -#define STACK_CHECK_EXPAND(STACK, STACK_LIMIT, STACK_BASE) \ - if (STACK_LIMIT >= STACK) { \ - Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)"); \ - } - -/* should work for now */ -#define STACK_CHECK_EXPAND1(STACK, STACK_LIMIT, STACK_BASE) STACK_CHECK_EXPAND(STACK, STACK_LIMIT, STACK_BASE) - -#else -#define STACK_CHECK_EXPAND(STACK, STACK_LIMIT, STACK_BASE) \ - if (STACK_LIMIT >= STACK) { \ - void *old_top; \ - UInt diff; \ - CELL *NEW_STACK; \ - INFORMATION_MESSAGE("Expanding trail in 64 Kbytes"); \ - old_top = Yap_TrailTop; \ - if (!Yap_growtrail(64 * 1024L, TRUE)) { \ - Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)"); \ - P = FAILCODE; \ - } else { \ - diff = (void *)Yap_TrailTop - old_top; \ - NEW_STACK = (CELL *)((void *)STACK + diff); \ - memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \ - STACK = NEW_STACK; \ - STACK_BASE = (CELL *)((void *)STACK_BASE + diff); \ - } \ - } -#endif /* YAPOR */ - - +#define MAX_NODES_PER_TRIE_LEVEL 8 +#define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2) +#define BASE_HASH_BUCKETS 64 +#define HASH_ENTRY(ENTRY, SEED) ((((unsigned long int) ENTRY) >> NumberOfLowTagBits) & (SEED)) #ifdef GLOBAL_TRIE -#define INCREMENT_GLOBAL_TRIE_REFS(NODE) \ - { register gt_node_ptr gt_node = NODE; \ - TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) + 1); \ - } -#define DECREMENT_GLOBAL_TRIE_REFS(NODE) \ - { register gt_node_ptr gt_node = NODE; \ - TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) - 1); \ - if (TrNode_child(gt_node) == 0) \ - free_global_trie_branch(gt_node); \ - } -#else -#define INCREMENT_GLOBAL_TRIE_REFS(NODE) -#define DECREMENT_GLOBAL_TRIE_REFS(NODE) +#define GLOBAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS)) +#define IS_GLOBAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == GLOBAL_TRIE_HASH_MARK) #endif /* GLOBAL_TRIE */ -#define TAG_AS_ANSWER_LEAF_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((unsigned long int) TrNode_parent(NODE) | 0x1) -#define UNTAG_ANSWER_LEAF_NODE(NODE) ((ans_node_ptr)((unsigned long int) NODE & ~(0x1))) -#define IS_ANSWER_LEAF_NODE(NODE) ((unsigned long int) TrNode_parent(NODE) & 0x1) +#define SUBGOAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS)) +#define IS_SUBGOAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == SUBGOAL_TRIE_HASH_MARK) +#define ANSWER_TRIE_HASH_MARK 0 +#define IS_ANSWER_TRIE_HASH(NODE) (TrNode_instr(NODE) == ANSWER_TRIE_HASH_MARK) - -/* LowTagBits is 3 for 32 bit-machines and 7 for 64 bit-machines */ -#define NumberOfLowTagBits (LowTagBits == 3 ? 2 : 3) -#define MakeTableVarTerm(INDEX) (INDEX << NumberOfLowTagBits) -#define VarIndexOfTableTerm(TERM) (((unsigned int) TERM) >> NumberOfLowTagBits) -#define VarIndexOfTerm(TERM) \ - ((((CELL) TERM) - GLOBAL_table_var_enumerator(0)) / sizeof(CELL)) -#define IsTableVarTerm(TERM) \ - ((CELL) TERM) >= GLOBAL_table_var_enumerator(0) && \ - ((CELL) TERM) <= GLOBAL_table_var_enumerator(MAX_TABLE_VARS - 1) -#ifdef TRIE_COMPACT_PAIRS -#define PairTermMark NULL -#define CompactPairInit AbsPair((Term *) 0) -#define CompactPairEndTerm AbsPair((Term *) (LowTagBits + 1)) -#define CompactPairEndList AbsPair((Term *) (2*(LowTagBits + 1))) -#endif /* TRIE_COMPACT_PAIRS */ - - -#define HASH_TABLE_LOCK(NODE) ((((unsigned long int) NODE) >> 5) & (TABLE_LOCK_BUCKETS - 1)) +#define HASH_TABLE_LOCK(NODE) ((((unsigned long int) (NODE)) >> 5) & (TABLE_LOCK_BUCKETS - 1)) #define LOCK_TABLE(NODE) LOCK(GLOBAL_table_lock(HASH_TABLE_LOCK(NODE))) #define UNLOCK_TABLE(NODE) UNLOCK(GLOBAL_table_lock(HASH_TABLE_LOCK(NODE))) - -#define frame_with_suspensions_not_collected(OR_FR) (OrFr_nearest_suspnode(OR_FR) == NULL) - +#define STACK_PUSH_UP(ITEM, STACK) *--(STACK) = (CELL)(ITEM) +#define STACK_POP_UP(STACK) *--(STACK) +#define STACK_PUSH_DOWN(ITEM, STACK) *(STACK)++ = (CELL)(ITEM) +#define STACK_POP_DOWN(STACK) *(STACK)++ +#define STACK_NOT_EMPTY(STACK, STACK_BASE) (STACK) != (STACK_BASE) +#define AUX_STACK_CHECK_EXPAND(STACK, STACK_LIMIT) if ((STACK_LIMIT) >= (STACK)) EXPAND_AUX_STACK(STACK) +#ifdef YAPOR +#define EXPAND_AUX_STACK(STACK) Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)"); +#else +#define EXPAND_AUX_STACK(STACK) STACK = expand_auxiliary_stack(STACK) +#endif /* YAPOR */ #ifdef YAPOR +#define frame_with_suspensions_not_collected(OR_FR) \ + (OrFr_nearest_suspnode(OR_FR) == NULL) #define find_dependency_node(SG_FR, LEADER_CP, DEP_ON_STACK) \ if (SgFr_gen_worker(SG_FR) == worker_id) { \ LEADER_CP = SgFr_gen_cp(SG_FR); \ @@ -207,6 +165,19 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p chain_dep_fr = DepFr_next(chain_dep_fr); \ } \ } +#ifdef TIMESTAMP +#define DepFr_init_timestamp_field(DEP_FR) DepFr_timestamp(DEP_FR) = 0 +#else +#define DepFr_init_timestamp_field(DEP_FR) +#endif /* TIMESTAMP */ +#define YAPOR_SET_LOAD(CP_PTR) SCH_set_load(CP_PTR) +#define SgFr_init_yapor_fields(SG_FR) \ + SgFr_gen_worker(SG_FR) = worker_id; \ + SgFr_gen_top_or_fr(SG_FR) = LOCAL_top_or_fr +#define DepFr_init_yapor_fields(DEP_FR, DEP_ON_STACK, TOP_OR_FR) \ + DepFr_leader_dep_is_on_stack(DEP_FR) = DEP_ON_STACK; \ + DepFr_top_or_fr(DEP_FR) = TOP_OR_FR; \ + DepFr_init_timestamp_field(DEP_FR) #else #define find_dependency_node(SG_FR, LEADER_CP, DEP_ON_STACK) \ LEADER_CP = SgFr_gen_cp(SG_FR); \ @@ -221,37 +192,19 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p chain_dep_fr = DepFr_next(chain_dep_fr); \ } \ } -#endif /* YAPOR */ - - -#ifdef YAPOR -#ifdef TIMESTAMP -#define DepFr_init_timestamp_field(DEP_FR) DepFr_timestamp(DEP_FR) = 0 -#else -#define DepFr_init_timestamp_field(DEP_FR) -#endif /* TIMESTAMP */ -#define YAPOR_SET_LOAD(CP_PTR) SCH_set_load(CP_PTR) -#define SgFr_init_yapor_fields(SG_FR) \ - SgFr_gen_worker(SG_FR) = worker_id; \ - SgFr_gen_top_or_fr(SG_FR) = LOCAL_top_or_fr -#define DepFr_init_yapor_fields(DEP_FR, DEP_ON_STACK, TOP_OR_FR) \ - DepFr_leader_dep_is_on_stack(DEP_FR) = DEP_ON_STACK; \ - DepFr_top_or_fr(DEP_FR) = TOP_OR_FR; \ - DepFr_init_timestamp_field(DEP_FR) -#else #define YAPOR_SET_LOAD(CP_PTR) #define SgFr_init_yapor_fields(SG_FR) #define DepFr_init_yapor_fields(DEP_FR, DEP_ON_STACK, TOP_OR_FR) #endif /* YAPOR */ - #ifdef TABLE_LOCK_AT_ENTRY_LEVEL -#define TabEnt_init_lock_field(TAB_ENT) INIT_LOCK(TabEnt_lock(TAB_ENT)) +#define TabEnt_init_lock_field(TAB_ENT) \ + INIT_LOCK(TabEnt_lock(TAB_ENT)) #define SgHash_init_next_field(HASH, TAB_ENT) \ Hash_next(HASH) = TabEnt_hash_chain(TAB_ENT); \ TabEnt_hash_chain(TAB_ENT) = HASH -#define AnsHash_init_next_field(HASH, SG_FR) \ - Hash_next(HASH) = SgFr_hash_chain(SG_FR); \ +#define AnsHash_init_next_field(HASH, SG_FR) \ + Hash_next(HASH) = SgFr_hash_chain(SG_FR); \ SgFr_hash_chain(SG_FR) = HASH #else #define TabEnt_init_lock_field(TAB_ENT) @@ -260,18 +213,82 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p Hash_next(HASH) = TabEnt_hash_chain(TAB_ENT); \ TabEnt_hash_chain(TAB_ENT) = HASH; \ UNLOCK(TabEnt_lock(TAB_ENT)) -#define AnsHash_init_next_field(HASH, SG_FR) \ - LOCK(SgFr_lock(SG_FR)); \ - Hash_next(HASH) = SgFr_hash_chain(SG_FR); \ - SgFr_hash_chain(SG_FR) = HASH; \ +#define AnsHash_init_next_field(HASH, SG_FR) \ + LOCK(SgFr_lock(SG_FR)); \ + Hash_next(HASH) = SgFr_hash_chain(SG_FR); \ + SgFr_hash_chain(SG_FR) = HASH; \ UNLOCK(SgFr_lock(SG_FR)) #endif /* TABLE_LOCK_AT_ENTRY_LEVEL */ + #ifdef TABLE_LOCK_AT_NODE_LEVEL -#define TrNode_init_lock_field(NODE) INIT_LOCK(TrNode_lock(NODE)) +#define TrNode_init_lock_field(NODE) \ + INIT_LOCK(TrNode_lock(NODE)) #else #define TrNode_init_lock_field(NODE) #endif /* TABLE_LOCK_AT_NODE_LEVEL */ +#ifdef GLOBAL_TRIE +#define INCREMENT_GLOBAL_TRIE_REFS(NODE) \ + { register gt_node_ptr gt_node = (gt_node_ptr) (NODE); \ + TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) + 1); \ + } +#define DECREMENT_GLOBAL_TRIE_REFS(NODE) \ + { register gt_node_ptr gt_node = (gt_node_ptr) (NODE); \ + TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) - 1); \ + if (TrNode_child(gt_node) == 0) \ + free_global_trie_branch(gt_node); \ + } +#else +#define INCREMENT_GLOBAL_TRIE_REFS(NODE) +#define DECREMENT_GLOBAL_TRIE_REFS(NODE) +#endif /* GLOBAL_TRIE */ + +#define new_table_entry(TAB_ENT, PRED_ENTRY, ATOM, ARITY) \ + { register sg_node_ptr sg_node; \ + new_root_subgoal_trie_node(sg_node); \ + ALLOC_TABLE_ENTRY(TAB_ENT); \ + TabEnt_init_lock_field(TAB_ENT); \ + TabEnt_pe(TAB_ENT) = PRED_ENTRY; \ + TabEnt_atom(TAB_ENT) = ATOM; \ + TabEnt_arity(TAB_ENT) = ARITY; \ + TabEnt_mode(TAB_ENT) = 0; \ + TabEnt_subgoal_trie(TAB_ENT) = sg_node; \ + TabEnt_hash_chain(TAB_ENT) = NULL; \ + TabEnt_next(TAB_ENT) = GLOBAL_root_tab_ent; \ + GLOBAL_root_tab_ent = TAB_ENT; \ + } + +#define new_subgoal_frame(SG_FR, CODE) \ + { register ans_node_ptr ans_node; \ + new_root_answer_trie_node(ans_node); \ + ALLOC_SUBGOAL_FRAME(SG_FR); \ + INIT_LOCK(SgFr_lock(SG_FR)); \ + SgFr_code(SG_FR) = CODE; \ + SgFr_state(SG_FR) = ready; \ + SgFr_hash_chain(SG_FR) = NULL; \ + SgFr_answer_trie(SG_FR) = ans_node; \ + SgFr_first_answer(SG_FR) = NULL; \ + SgFr_last_answer(SG_FR) = NULL; \ + } +#define init_subgoal_frame(SG_FR) \ + { SgFr_init_yapor_fields(SG_FR); \ + SgFr_state(SG_FR) = evaluating; \ + SgFr_next(SG_FR) = LOCAL_top_sg_fr; \ + LOCAL_top_sg_fr = SG_FR; \ + } + +#define new_dependency_frame(DEP_FR, DEP_ON_STACK, TOP_OR_FR, LEADER_CP, CONS_CP, SG_FR, NEXT) \ + ALLOC_DEPENDENCY_FRAME(DEP_FR); \ + INIT_LOCK(DepFr_lock(DEP_FR)); \ + DepFr_init_yapor_fields(DEP_FR, DEP_ON_STACK, TOP_OR_FR); \ + DepFr_backchain_cp(DEP_FR) = NULL; \ + DepFr_leader_cp(DEP_FR) = NORM_CP(LEADER_CP); \ + DepFr_cons_cp(DEP_FR) = NORM_CP(CONS_CP); \ + /* start with TrNode_child(DepFr_last_answer(DEP_FR)) pointing to SgFr_first_answer(SG_FR) */ \ + DepFr_last_answer(DEP_FR) = (ans_node_ptr) ((unsigned long int) (SG_FR) + \ + (unsigned long int) (&SgFr_first_answer((sg_fr_ptr)DEP_FR)) - \ + (unsigned long int) (&TrNode_child((ans_node_ptr)DEP_FR))); \ + DepFr_next(DEP_FR) = NEXT #define new_suspension_frame(SUSP_FR, TOP_OR_FR_ON_STACK, TOP_DEP, TOP_SG, \ H_REG, B_REG, TR_REG, H_SIZE, B_SIZE, TR_SIZE) \ @@ -292,66 +309,6 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p memcpy(SuspFr_local_start(SUSP_FR), SuspFr_local_reg(SUSP_FR), B_SIZE); \ memcpy(SuspFr_trail_start(SUSP_FR), SuspFr_trail_reg(SUSP_FR), TR_SIZE) - -#define new_subgoal_frame(SG_FR, CODE) \ - { register ans_node_ptr ans_node; \ - new_root_answer_trie_node(ans_node); \ - ALLOC_SUBGOAL_FRAME(SG_FR); \ - INIT_LOCK(SgFr_lock(SG_FR)); \ - SgFr_code(SG_FR) = CODE; \ - SgFr_state(SG_FR) = ready; \ - SgFr_hash_chain(SG_FR) = NULL; \ - SgFr_answer_trie(SG_FR) = ans_node; \ - SgFr_first_answer(SG_FR) = NULL; \ - SgFr_last_answer(SG_FR) = NULL; \ - } - - -#define init_subgoal_frame(SG_FR) \ - { SgFr_init_yapor_fields(SG_FR); \ - SgFr_state(SG_FR) = evaluating; \ - SgFr_next(SG_FR) = LOCAL_top_sg_fr; \ - LOCAL_top_sg_fr = SG_FR; \ - } - - -#define new_dependency_frame(DEP_FR, DEP_ON_STACK, TOP_OR_FR, LEADER_CP, CONS_CP, SG_FR, NEXT) \ - ALLOC_DEPENDENCY_FRAME(DEP_FR); \ - INIT_LOCK(DepFr_lock(DEP_FR)); \ - DepFr_init_yapor_fields(DEP_FR, DEP_ON_STACK, TOP_OR_FR); \ - DepFr_backchain_cp(DEP_FR) = NULL; \ - DepFr_leader_cp(DEP_FR) = NORM_CP(LEADER_CP); \ - DepFr_cons_cp(DEP_FR) = NORM_CP(CONS_CP); \ - /* start with TrNode_child(DepFr_last_answer(DEP_FR)) pointing to SgFr_first_answer(SG_FR) */ \ - DepFr_last_answer(DEP_FR) = (ans_node_ptr) ((unsigned long int) (SG_FR) + \ - (unsigned long int) (&SgFr_first_answer((sg_fr_ptr)DEP_FR)) - \ - (unsigned long int) (&TrNode_child((ans_node_ptr)DEP_FR))); \ - DepFr_next(DEP_FR) = NEXT - - -#define new_table_entry(TAB_ENT, PRED_ENTRY, ATOM, ARITY) \ - { register sg_node_ptr sg_node; \ - new_root_subgoal_trie_node(sg_node); \ - ALLOC_TABLE_ENTRY(TAB_ENT); \ - TabEnt_init_lock_field(TAB_ENT); \ - TabEnt_pe(TAB_ENT) = PRED_ENTRY; \ - TabEnt_atom(TAB_ENT) = ATOM; \ - TabEnt_arity(TAB_ENT) = ARITY; \ - TabEnt_mode(TAB_ENT) = 0; \ - TabEnt_subgoal_trie(TAB_ENT) = sg_node; \ - TabEnt_hash_chain(TAB_ENT) = NULL; \ - TabEnt_next(TAB_ENT) = GLOBAL_root_tab_ent; \ - GLOBAL_root_tab_ent = TAB_ENT; \ - } - - -#define new_global_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) \ - ALLOC_GLOBAL_TRIE_NODE(NODE); \ - TrNode_entry(NODE) = ENTRY; \ - TrNode_child(NODE) = CHILD; \ - TrNode_parent(NODE) = PARENT; \ - TrNode_next(NODE) = NEXT - #define new_root_subgoal_trie_node(NODE) \ ALLOC_SUBGOAL_TRIE_NODE(NODE); \ init_subgoal_trie_node(NODE, 0, NULL, NULL, NULL) @@ -360,13 +317,12 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p ALLOC_SUBGOAL_TRIE_NODE(NODE); \ init_subgoal_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) #define init_subgoal_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) \ - TrNode_entry(NODE) = ENTRY; \ + TrNode_entry(NODE) = ENTRY; \ TrNode_init_lock_field(NODE); \ - TrNode_child(NODE) = CHILD; \ + TrNode_child(NODE) = CHILD; \ TrNode_parent(NODE) = PARENT; \ TrNode_next(NODE) = NEXT - #define new_root_answer_trie_node(NODE) \ ALLOC_ANSWER_TRIE_NODE(NODE); \ init_answer_trie_node(NODE, 0, 0, NULL, NULL, NULL) @@ -382,30 +338,12 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p TrNode_parent(NODE) = PARENT; \ TrNode_next(NODE) = NEXT - -#define MAX_NODES_PER_TRIE_LEVEL 8 -#define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2) -#define BASE_HASH_BUCKETS 64 -#define HASH_ENTRY(ENTRY, SEED) ((((unsigned long int) ENTRY) >> NumberOfLowTagBits) & (SEED)) -#ifdef GLOBAL_TRIE -#define GLOBAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS)) -#define IS_GLOBAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == GLOBAL_TRIE_HASH_MARK) -#define SUBGOAL_TRIE_HASH_MARK (NULL) -#else -#define SUBGOAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS)) -#endif /* GLOBAL_TRIE */ -#define IS_SUBGOAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == SUBGOAL_TRIE_HASH_MARK) -#define ANSWER_TRIE_HASH_MARK 0 -#define IS_ANSWER_TRIE_HASH(NODE) (TrNode_instr(NODE) == ANSWER_TRIE_HASH_MARK) - - -#define new_global_trie_hash(HASH, NUM_NODES) \ - ALLOC_GLOBAL_TRIE_HASH(HASH); \ - Hash_mark(HASH) = GLOBAL_TRIE_HASH_MARK; \ - Hash_num_buckets(HASH) = BASE_HASH_BUCKETS; \ - ALLOC_HASH_BUCKETS(Hash_buckets(HASH), BASE_HASH_BUCKETS); \ - Hash_num_nodes(HASH) = NUM_NODES - +#define new_global_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) \ + ALLOC_GLOBAL_TRIE_NODE(NODE); \ + TrNode_entry(NODE) = ENTRY; \ + TrNode_child(NODE) = CHILD; \ + TrNode_parent(NODE) = PARENT; \ + TrNode_next(NODE) = NEXT #define new_subgoal_trie_hash(HASH, NUM_NODES, TAB_ENT) \ ALLOC_SUBGOAL_TRIE_HASH(HASH); \ @@ -415,7 +353,6 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p Hash_num_nodes(HASH) = NUM_NODES; \ SgHash_init_next_field(HASH, TAB_ENT) - #define new_answer_trie_hash(HASH, NUM_NODES, SG_FR) \ ALLOC_ANSWER_TRIE_HASH(HASH); \ Hash_mark(HASH) = ANSWER_TRIE_HASH_MARK; \ @@ -424,6 +361,12 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p Hash_num_nodes(HASH) = NUM_NODES; \ AnsHash_init_next_field(HASH, SG_FR) +#define new_global_trie_hash(HASH, NUM_NODES) \ + ALLOC_GLOBAL_TRIE_HASH(HASH); \ + Hash_mark(HASH) = GLOBAL_TRIE_HASH_MARK; \ + Hash_num_buckets(HASH) = BASE_HASH_BUCKETS; \ + ALLOC_HASH_BUCKETS(Hash_buckets(HASH), BASE_HASH_BUCKETS); \ + Hash_num_nodes(HASH) = NUM_NODES #ifdef LIMIT_TABLING #define insert_into_global_sg_fr_list(SG_FR) \ @@ -455,9 +398,25 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p -/* ------------------------- ** +/****************************** ** 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 void adjust_freeze_registers(void) { @@ -898,11 +857,6 @@ susp_fr_ptr suspension_frame_to_resume(or_fr_ptr susp_or_fr) { #endif /* YAPOR */ - -/* --------------------------------------------------- ** -** Cut Stuff: Managing table subgoal answers ** -** --------------------------------------------------- */ - #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) { diff --git a/OPTYap/tab.structs.h b/OPTYap/tab.structs.h index 448a3d0f7..be7bb2399 100644 --- a/OPTYap/tab.structs.h +++ b/OPTYap/tab.structs.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: tab.structs.h - version: $Id: tab.structs.h,v 1.10 2005-08-04 15:45:56 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ---------------------------- ** +/********************************* ** Tabling mode flags ** -** ---------------------------- */ +*********************************/ #define Mode_SchedulingOn 0x00000001L /* yap_flags[TABLING_MODE_FLAG] */ #define Mode_CompletedOn 0x00000002L /* yap_flags[TABLING_MODE_FLAG] */ @@ -49,9 +51,9 @@ -/* ---------------------------- ** +/********************************* ** Struct table_entry ** -** ---------------------------- */ +*********************************/ typedef struct table_entry { #if defined(YAPOR) || defined(THREADS) @@ -77,9 +79,9 @@ typedef struct table_entry { -/* -------------------------------------------------------------------------- ** +/******************************************************************************* ** Structs global_trie_node, subgoal_trie_node and answer_trie_node ** -** -------------------------------------------------------------------------- */ +*******************************************************************************/ #ifdef GLOBAL_TRIE typedef struct global_trie_node { @@ -91,11 +93,7 @@ typedef struct global_trie_node { #endif /* GLOBAL_TRIE */ typedef struct subgoal_trie_node { -#ifdef GLOBAL_TRIE - struct global_trie_node *entry; -#else Term entry; -#endif /* GLOBAL_TRIE */ #ifdef TABLE_LOCK_AT_NODE_LEVEL lockvar lock; #endif /* TABLE_LOCK_AT_NODE_LEVEL */ @@ -109,11 +107,7 @@ typedef struct answer_trie_node { #ifdef YAPOR int or_arg; /* u.Otapl.or_arg */ #endif /* YAPOR */ -#ifdef GLOBAL_TRIE - struct global_trie_node *entry; -#else Term entry; -#endif /* GLOBAL_TRIE */ #ifdef TABLE_LOCK_AT_NODE_LEVEL lockvar lock; #endif /* TABLE_LOCK_AT_NODE_LEVEL */ @@ -133,14 +127,14 @@ typedef struct answer_trie_node { -/* -------------------------------------------------------------------------- ** +/******************************************************************************* ** Structs global_trie_hash, subgoal_trie_hash and answer_trie_hash ** -** -------------------------------------------------------------------------- */ +*******************************************************************************/ #ifdef GLOBAL_TRIE typedef struct global_trie_hash { /* the first field is used for compatibility ** - ** with the global_trie_node data structure */ + ** with the global_trie_node data structure */ Term mark; int number_of_buckets; struct global_trie_node **buckets; @@ -151,11 +145,7 @@ typedef struct global_trie_hash { typedef struct subgoal_trie_hash { /* the first field is used for compatibility ** ** with the subgoal_trie_node data structure */ -#ifdef GLOBAL_TRIE - struct global_trie_node *mark; -#else Term mark; -#endif /* GLOBAL_TRIE */ int number_of_buckets; struct subgoal_trie_node **buckets; int number_of_nodes; @@ -182,9 +172,9 @@ typedef struct answer_trie_hash { -/* ------------------------------ ** +/*********************************** ** Struct subgoal_frame ** -** ------------------------------ */ +***********************************/ typedef struct subgoal_frame { #if defined(YAPOR) || defined(THREADS) @@ -234,35 +224,37 @@ typedef struct subgoal_frame { #define SgFr_previous(X) ((X)->previous) #define SgFr_next(X) ((X)->next) -/* ------------------------------------------------------------------------------------------- ** - SgFr_lock: spin-lock to modify the frame fields. - SgFr_gen_worker: the id of the worker that had allocated the frame. - SgFr_gen_top_or_fr: a pointer to the top or-frame in the generator choice point branch. - When the generator choice point is shared the pointer is updated - to its or-frame. It is used to find the direct dependency node for - consumer nodes in other workers branches. - SgFr_code initial instruction of the subgoal's compiled code. - SgFr_tab_ent a pointer to the correspondent table entry. - SgFr_arity the arity of the subgoal. - SgFr_state: a flag that indicates the subgoal state. - SgFr_gen_cp: a pointer to the correspondent generator choice point. - SgFr_hash_chain: a pointer to the first answer_trie_hash struct for the subgoal in hand. - SgFr_answer_trie: a pointer to the top answer trie node. - It is used to check for/insert new answers. - SgFr_first_answer: a pointer to the bottom answer trie node of the first available answer. - SgFr_last_answer: a pointer to the bottom answer trie node of the last available answer. - SgFr_try_answer: a pointer to the bottom answer trie node of the last tried answer. - It is used when a subgoal was not completed during the previous evaluation. - Not completed subgoals start by trying the answers already found. - SgFr_previous: a pointer to the previous subgoal frame on the chain. - SgFr_next: a pointer to the next subgoal frame on the chain. -** ------------------------------------------------------------------------------------------- */ +/************************************************************************************************** + + SgFr_lock: spin-lock to modify the frame fields. + SgFr_gen_worker: the id of the worker that had allocated the frame. + SgFr_gen_top_or_fr: a pointer to the top or-frame in the generator choice point branch. + When the generator choice point is shared the pointer is updated + to its or-frame. It is used to find the direct dependency node for + consumer nodes in other workers branches. + SgFr_code initial instruction of the subgoal's compiled code. + SgFr_tab_ent a pointer to the correspondent table entry. + SgFr_arity the arity of the subgoal. + SgFr_state: a flag that indicates the subgoal state. + SgFr_gen_cp: a pointer to the correspondent generator choice point. + SgFr_hash_chain: a pointer to the first answer_trie_hash struct for the subgoal in hand. + SgFr_answer_trie: a pointer to the top answer trie node. + It is used to check for/insert new answers. + SgFr_first_answer: a pointer to the bottom answer trie node of the first available answer. + SgFr_last_answer: a pointer to the bottom answer trie node of the last available answer. + SgFr_try_answer: a pointer to the bottom answer trie node of the last tried answer. + It is used when a subgoal was not completed during the previous evaluation. + Not completed subgoals start by trying the answers already found. + SgFr_previous: a pointer to the previous subgoal frame on the chain. + SgFr_next: a pointer to the next subgoal frame on the chain. + +**************************************************************************************************/ -/* --------------------------------- ** +/************************************** ** Struct dependency_frame ** -** --------------------------------- */ +**************************************/ typedef struct dependency_frame { #if defined(YAPOR) || defined(THREADS) @@ -292,30 +284,32 @@ typedef struct dependency_frame { #define DepFr_last_answer(X) ((X)->last_consumed_answer) #define DepFr_next(X) ((X)->next) -/* ---------------------------------------------------------------------------------------------------- ** - DepFr_lock: lock variable to modify the frame fields. - DepFr_leader_dep_is_on_stack: the generator choice point for the correspondent consumer choice point - is on the worker's stack (FALSE/TRUE). - DepFr_top_or_fr: a pointer to the top or-frame in the consumer choice point branch. - When the consumer choice point is shared the pointer is updated to - its or-frame. It is used to update the LOCAL_top_or_fr when a worker - backtracks through answers. - DepFr_timestamp: a timestamp used to optimize the search for suspension frames to be - resumed. - DepFr_backchain_cp: a pointer to the nearest choice point with untried alternatives. - It is used to efficiently return (backtrack) to the leader node where - we perform the last backtracking through answers operation. - DepFr_leader_cp: a pointer to the leader choice point. - DepFr_cons_cp: a pointer to the correspondent consumer choice point. - DepFr_last_answer: a pointer to the last consumed answer. - DepFr_next: a pointer to the next dependency frame on the chain. -** ---------------------------------------------------------------------------------------------------- */ +/******************************************************************************************************* + + DepFr_lock: lock variable to modify the frame fields. + DepFr_leader_dep_is_on_stack: the generator choice point for the correspondent consumer choice point + is on the worker's stack (FALSE/TRUE). + DepFr_top_or_fr: a pointer to the top or-frame in the consumer choice point branch. + When the consumer choice point is shared the pointer is updated to + its or-frame. It is used to update the LOCAL_top_or_fr when a worker + backtracks through answers. + DepFr_timestamp: a timestamp used to optimize the search for suspension frames to be + resumed. + DepFr_backchain_cp: a pointer to the nearest choice point with untried alternatives. + It is used to efficiently return (backtrack) to the leader node where + we perform the last backtracking through answers operation. + DepFr_leader_cp: a pointer to the leader choice point. + DepFr_cons_cp: a pointer to the correspondent consumer choice point. + DepFr_last_answer: a pointer to the last consumed answer. + DepFr_next: a pointer to the next dependency frame on the chain. + +*******************************************************************************************************/ -/* --------------------------------- ** +/************************************** ** Struct suspension_frame ** -** --------------------------------- */ +**************************************/ #ifdef YAPOR typedef struct suspension_frame { @@ -347,9 +341,9 @@ typedef struct suspension_frame { -/* ------------------------------- ** +/************************************ ** Structs choice points ** -** ------------------------------- */ +************************************/ struct generator_choicept { struct choicept cp; diff --git a/OPTYap/tab.suspend.c b/OPTYap/tab.suspend.c index 2ee227e0e..1347f005a 100644 --- a/OPTYap/tab.suspend.c +++ b/OPTYap/tab.suspend.c @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: tab.suspend.c - version: $Id: tab.suspend.c,v 1.5 2008-05-23 18:28:58 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** -** ------------------ */ +/************************************ +** Includes & Prototypes ** +************************************/ #include "Yap.h" #if defined(TABLING) && defined(YAPOR) @@ -20,19 +22,88 @@ #include "tab.macros.h" #include "or.macros.h" - - -/* ------------------------------------- ** -** Local functions declaration ** -** ------------------------------------- */ - -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); +static void complete_suspension_branch(susp_fr_ptr, choiceptr, or_fr_ptr *, dep_fr_ptr *); -/* -------------------------- ** +/****************************** +** Local functions ** +******************************/ + +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; + dep_fr_ptr aux_dep_fr; + + /* complete all subgoals */ + aux_dep_fr = SuspFr_top_dep_fr(susp_fr); + aux_sg_fr = SuspFr_top_sg_fr(susp_fr); + if (DepFr_leader_dep_is_on_stack(aux_dep_fr)) { + while (aux_sg_fr && + /* continue if the subgoal was early completed */ + /* SgFr_state(aux_sg_fr) == evaluating && */ + (SgFr_state(aux_sg_fr) == evaluating || SgFr_first_answer(aux_sg_fr) == SgFr_answer_trie(aux_sg_fr)) && + EQUAL_OR_YOUNGER_CP(SgFr_gen_cp(aux_sg_fr), top_cp)) { + mark_as_completed(aux_sg_fr); + aux_sg_fr = SgFr_next(aux_sg_fr); + } + } else { + while (aux_sg_fr && + /* continue if the subgoal was early completed */ + /* SgFr_state(aux_sg_fr) == evaluating && */ + (SgFr_state(aux_sg_fr) == evaluating || SgFr_first_answer(aux_sg_fr) == SgFr_answer_trie(aux_sg_fr)) && + YOUNGER_CP(SgFr_gen_cp(aux_sg_fr), top_cp)) { + mark_as_completed(aux_sg_fr); + aux_sg_fr = SgFr_next(aux_sg_fr); + } + } + + /* chain dependency frames to release (using DepFr_next) */ + while (IS_UNLOCKED(DepFr_lock(aux_dep_fr)) && + YOUNGER_CP(DepFr_cons_cp(aux_dep_fr), top_cp)) { + dep_fr_ptr next_dep_fr; + LOCK(DepFr_lock(aux_dep_fr)); + next_dep_fr = DepFr_next(aux_dep_fr); + DepFr_next(aux_dep_fr) = *chain_dep_fr; + *chain_dep_fr = aux_dep_fr; + aux_dep_fr = next_dep_fr; + } + + /* chain or-frames to release (using OrFr_next_on_stack) ** + ** we use the OrFr_next_on_stack field instead of OrFr_next ** + ** to avoid conflicts with the 'find_dependency_node' macro */ + aux_or_fr = SuspFr_top_or_fr_on_stack(susp_fr); + while (IS_UNLOCKED(OrFr_lock(aux_or_fr))) { + susp_fr_ptr aux_susp_fr; + or_fr_ptr next_or_fr_on_stack; +#ifdef OPTYAP_ERRORS + if (YOUNGER_CP(top_cp, GetOrFr_node(aux_or_fr))) + OPTYAP_ERROR_MESSAGE("YOUNGER_CP(top_cp, GetOrFr_node(aux_or_fr)) (complete_suspension_branch)"); +#endif /* OPTYAP_ERRORS */ + LOCK_OR_FRAME(aux_or_fr); + aux_susp_fr = OrFr_suspensions(aux_or_fr); + while (aux_susp_fr) { + susp_fr_ptr next_susp_fr; + complete_suspension_branch(aux_susp_fr, GetOrFr_node(aux_or_fr), chain_or_fr, chain_dep_fr); + next_susp_fr = SuspFr_next(aux_susp_fr); + FREE_SUSPENSION_FRAME(aux_susp_fr); + aux_susp_fr = next_susp_fr; + } + next_or_fr_on_stack = OrFr_next_on_stack(aux_or_fr); + OrFr_next_on_stack(aux_or_fr) = *chain_or_fr; + *chain_or_fr = aux_or_fr; + aux_or_fr = next_or_fr_on_stack; + } + + return; +} +#endif /* TABLING && YAPOR */ + + + +/******************************* ** Global functions ** -** -------------------------- */ +*******************************/ void public_completion(void) { dep_fr_ptr chain_dep_fr, next_dep_fr; @@ -356,79 +427,3 @@ void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr) { return; } - - - -/* ------------------------- ** -** Local functions ** -** ------------------------- */ - -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; - dep_fr_ptr aux_dep_fr; - - /* complete all subgoals */ - aux_dep_fr = SuspFr_top_dep_fr(susp_fr); - aux_sg_fr = SuspFr_top_sg_fr(susp_fr); - if (DepFr_leader_dep_is_on_stack(aux_dep_fr)) { - while (aux_sg_fr && - /* continue if the subgoal was early completed */ - /* SgFr_state(aux_sg_fr) == evaluating && */ - (SgFr_state(aux_sg_fr) == evaluating || SgFr_first_answer(aux_sg_fr) == SgFr_answer_trie(aux_sg_fr)) && - EQUAL_OR_YOUNGER_CP(SgFr_gen_cp(aux_sg_fr), top_cp)) { - mark_as_completed(aux_sg_fr); - aux_sg_fr = SgFr_next(aux_sg_fr); - } - } else { - while (aux_sg_fr && - /* continue if the subgoal was early completed */ - /* SgFr_state(aux_sg_fr) == evaluating && */ - (SgFr_state(aux_sg_fr) == evaluating || SgFr_first_answer(aux_sg_fr) == SgFr_answer_trie(aux_sg_fr)) && - YOUNGER_CP(SgFr_gen_cp(aux_sg_fr), top_cp)) { - mark_as_completed(aux_sg_fr); - aux_sg_fr = SgFr_next(aux_sg_fr); - } - } - - /* chain dependency frames to release (using DepFr_next) */ - while (IS_UNLOCKED(DepFr_lock(aux_dep_fr)) && - YOUNGER_CP(DepFr_cons_cp(aux_dep_fr), top_cp)) { - dep_fr_ptr next_dep_fr; - LOCK(DepFr_lock(aux_dep_fr)); - next_dep_fr = DepFr_next(aux_dep_fr); - DepFr_next(aux_dep_fr) = *chain_dep_fr; - *chain_dep_fr = aux_dep_fr; - aux_dep_fr = next_dep_fr; - } - - /* chain or-frames to release (using OrFr_next_on_stack) ** - ** we use the OrFr_next_on_stack field instead of OrFr_next ** - ** to avoid conflicts with the 'find_dependency_node' macro */ - aux_or_fr = SuspFr_top_or_fr_on_stack(susp_fr); - while (IS_UNLOCKED(OrFr_lock(aux_or_fr))) { - susp_fr_ptr aux_susp_fr; - or_fr_ptr next_or_fr_on_stack; -#ifdef OPTYAP_ERRORS - if (YOUNGER_CP(top_cp, GetOrFr_node(aux_or_fr))) - OPTYAP_ERROR_MESSAGE("YOUNGER_CP(top_cp, GetOrFr_node(aux_or_fr)) (complete_suspension_branch)"); -#endif /* OPTYAP_ERRORS */ - LOCK_OR_FRAME(aux_or_fr); - aux_susp_fr = OrFr_suspensions(aux_or_fr); - while (aux_susp_fr) { - susp_fr_ptr next_susp_fr; - complete_suspension_branch(aux_susp_fr, GetOrFr_node(aux_or_fr), chain_or_fr, chain_dep_fr); - next_susp_fr = SuspFr_next(aux_susp_fr); - FREE_SUSPENSION_FRAME(aux_susp_fr); - aux_susp_fr = next_susp_fr; - } - next_or_fr_on_stack = OrFr_next_on_stack(aux_or_fr); - OrFr_next_on_stack(aux_or_fr) = *chain_or_fr; - *chain_or_fr = aux_or_fr; - aux_or_fr = next_or_fr_on_stack; - } - - return; -} -#endif /* TABLING && YAPOR */ diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index 479d43cd4..1160547e9 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: tab.tries.C - version: $Id: tab.tries.c,v 1.24 2008-05-20 18:25:37 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** -** ------------------ */ +/************************************ +** Includes & Prototypes ** +************************************/ #include "Yap.h" #ifdef TABLING @@ -24,46 +26,96 @@ #include "yapio.h" #include "tab.macros.h" - -/* ------------------------------------- ** -** Local functions declaration ** -** ------------------------------------- */ - +static inline sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr, sg_node_ptr, Term); +static inline ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr, ans_node_ptr, Term, int); +#ifndef GLOBAL_TRIE +static inline sg_node_ptr subgoal_search_subterm(tab_ent_ptr, sg_node_ptr, Term, int *, CELL **); +static inline ans_node_ptr answer_search_subterm(sg_fr_ptr, ans_node_ptr, Term, int *); +static inline CELL *load_answer_subterm(ans_node_ptr); +#else /* GLOBAL_TRIE */ +static inline gt_node_ptr global_trie_node_check_insert(gt_node_ptr, Term); +#ifdef GLOBAL_TRIE_FOR_TERMS +static inline gt_node_ptr subgoal_search_subterm(Term, int *, CELL **); +static inline gt_node_ptr answer_search_subterm(Term, int *); +static inline CELL *load_answer_subterm(gt_node_ptr, int *, CELL *); +static inline CELL *load_substitution_variable_subterm(gt_node_ptr, CELL **, CELL *); +#elif GLOBAL_TRIE_FOR_SUBTERMS +static gt_node_ptr subgoal_search_subterm(Term, int *, CELL **, CELL *); +static gt_node_ptr answer_search_suberm(Term, int *, CELL *); +static CELL *load_answer_subterm(gt_node_ptr, int *, CELL *); +static CELL *load_substitution_variable_subterm(gt_node_ptr, CELL **, CELL *); +#endif /* GLOBAL_TRIE_MODE */ +static void free_global_trie_branch(gt_node_ptr); +static void traverse_global_trie(gt_node_ptr, char *, int, int *, int, int); +static void traverse_global_trie_for_subgoal(gt_node_ptr, char *, int *, int *, int *); +static void traverse_global_trie_for_answer(gt_node_ptr, char *, int *, int *, int *); +#endif /* GLOBAL_TRIE */ +static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int, int); +static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int, int); +static inline void traverse_trie_node(Term, char *, int *, int *, int *, int); #ifdef YAPOR #ifdef TABLING_INNER_CUTS -static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr current_node); -#else -static int update_answer_trie_branch(ans_node_ptr current_node); +static int update_answer_trie_branch(ans_node_ptr, ans_node_ptr); +#else /* YAPOR && ! TABLING_INNER_CUTS */ +static int update_answer_trie_branch(ans_node_ptr); +#endif +#else /* ! YAPOR */ +static void update_answer_trie_branch(ans_node_ptr, int); +#endif + + + +/******************************* +** Structs & Macros ** +*******************************/ + +static struct trie_statistics{ + int show; + long subgoals; + long subgoals_incomplete; + long subgoal_trie_nodes; + long answers; +#ifdef TABLING_INNER_CUTS + long answers_pruned; #endif /* TABLING_INNER_CUTS */ -#else -static void update_answer_trie_branch(ans_node_ptr current_node, int position); -#endif /* YAPOR */ -static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position); -static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_index, int *arity, int var_index, int mode, int position); -static void traverse_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type); + long answers_true; + long answers_no; + long answer_trie_nodes; #ifdef GLOBAL_TRIE -static void free_global_trie_branch(gt_node_ptr current_node); -static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position); -static void traverse_global_trie_for_subgoal(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode); -static void traverse_global_trie_for_answer(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode); + long global_trie_terms; + long global_trie_nodes; #endif /* GLOBAL_TRIE */ +} trie_stats; - - -/* ----------------------- ** -** Local inlines ** -** ----------------------- */ +#define TrStat_show trie_stats.show +#define TrStat_subgoals trie_stats.subgoals +#define TrStat_sg_incomplete trie_stats.subgoals_incomplete +#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes +#define TrStat_answers trie_stats.answers +#define TrStat_answers_true trie_stats.answers_true +#define TrStat_answers_no trie_stats.answers_no +#define TrStat_answers_pruned trie_stats.answers_pruned +#define TrStat_ans_nodes trie_stats.answer_trie_nodes +#define TrStat_gt_terms trie_stats.global_trie_terms +#define TrStat_gt_nodes trie_stats.global_trie_nodes +#define SHOW_TABLE_STR_ARRAY_SIZE 100000 +#define SHOW_TABLE_ARITY_ARRAY_SIZE 10000 +#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \ + if (TrStat_show == SHOW_MODE_STRUCTURE) \ + fprintf(Yap_stdout, MESG, ##ARGS) #ifdef GLOBAL_TRIE -STD_PROTO(static inline gt_node_ptr global_trie_node_check_insert, (gt_node_ptr, Term)); -STD_PROTO(static inline sg_node_ptr subgoal_trie_node_check_insert, (tab_ent_ptr, sg_node_ptr, gt_node_ptr)); -STD_PROTO(static inline ans_node_ptr answer_trie_node_check_insert, (sg_fr_ptr, ans_node_ptr, gt_node_ptr, int)); -#else -STD_PROTO(static inline sg_node_ptr subgoal_trie_node_check_insert, (tab_ent_ptr, sg_node_ptr, Term)); -STD_PROTO(static inline ans_node_ptr answer_trie_node_check_insert, (sg_fr_ptr, ans_node_ptr, Term, int)); +#define SUBGOAL_TOKEN_CHECK_INSERT(TAB_ENT, NODE, TOKEN) \ + NODE = global_trie_node_check_insert(NODE, TOKEN) +#define ANSWER_TOKEN_CHECK_INSERT(SG_FR, NODE, TOKEN, INSTR) \ + NODE = global_trie_node_check_insert(NODE, TOKEN) +#else /* ! GLOBAL_TRIE */ +#define SUBGOAL_TOKEN_CHECK_INSERT(TAB_ENT, NODE, TOKEN) \ + NODE = subgoal_trie_node_check_insert(TAB_ENT, NODE, TOKEN) +#define ANSWER_TOKEN_CHECK_INSERT(SG_FR, NODE, TOKEN, INSTR) \ + NODE = answer_trie_node_check_insert(SG_FR, NODE, TOKEN, INSTR) #endif /* GLOBAL_TRIE */ - #if defined(TABLE_LOCK_AT_WRITE_LEVEL) #define LOCK_NODE(NODE) LOCK_TABLE(NODE) #define UNLOCK_NODE(NODE) UNLOCK_TABLE(NODE) @@ -76,27 +128,17 @@ STD_PROTO(static inline ans_node_ptr answer_trie_node_check_insert, (sg_fr_ptr, #endif /* TABLE_LOCK_LEVEL */ -#ifdef GLOBAL_TRIE -#define SUBGOAL_TOKEN_CHECK_INSERT(TAB_ENT, NODE, TOKEN) \ - NODE = global_trie_node_check_insert(NODE, TOKEN) -#define ANSWER_TOKEN_CHECK_INSERT(SG_FR, NODE, TOKEN, INSTR) \ - NODE = global_trie_node_check_insert(NODE, TOKEN) -#else -#define SUBGOAL_TOKEN_CHECK_INSERT(TAB_ENT, NODE, TOKEN) \ - NODE = subgoal_trie_node_check_insert(TAB_ENT, NODE, TOKEN) -#define ANSWER_TOKEN_CHECK_INSERT(SG_FR, NODE, TOKEN, INSTR) \ - NODE = answer_trie_node_check_insert(SG_FR, NODE, TOKEN, INSTR) -#endif /* GLOBAL_TRIE */ +/****************************** +** Local functions ** +******************************/ #ifdef TABLE_LOCK_AT_WRITE_LEVEL -static inline -sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { +static inline sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { sg_node_ptr child_node; sg_hash_ptr hash; child_node = TrNode_child(parent_node); - if (child_node == NULL) { #ifdef ALLOC_BEFORE_CHECK new_subgoal_trie_node(child_node, t, NULL, parent_node, NULL); @@ -279,8 +321,7 @@ subgoal_trie_hash: } -static inline -ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { +static inline ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { ans_node_ptr child_node; ans_hash_ptr hash; @@ -290,7 +331,6 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_ #endif /* TABLING_ERRORS */ child_node = TrNode_child(parent_node); - if (child_node == NULL) { #ifdef ALLOC_BEFORE_CHECK new_answer_trie_node(child_node, instr, t, NULL, parent_node, NULL); @@ -472,114 +512,11 @@ answer_trie_hash: } } #else /* TABLE_LOCK_AT_ENTRY_LEVEL || TABLE_LOCK_AT_NODE_LEVEL || ! YAPOR */ -#ifdef GLOBAL_TRIE -static inline -gt_node_ptr global_trie_node_check_insert(gt_node_ptr parent_node, Term t) { - gt_node_ptr child_node; - - LOCK_NODE(parent_node); - child_node = TrNode_child(parent_node); - - if (child_node == NULL) { - new_global_trie_node(child_node, t, NULL, parent_node, NULL); - TrNode_child(parent_node) = child_node; - UNLOCK_NODE(parent_node); - return child_node; - } - - if (! IS_GLOBAL_TRIE_HASH(child_node)) { - int count_nodes = 0; - do { - if (TrNode_entry(child_node) == t) { - UNLOCK_NODE(parent_node); - return child_node; - } - count_nodes++; - child_node = TrNode_next(child_node); - } while (child_node); - new_global_trie_node(child_node, t, NULL, parent_node, TrNode_child(parent_node)); - count_nodes++; - if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) { - /* alloc a new hash */ - gt_hash_ptr hash; - gt_node_ptr chain_node, next_node, *bucket; - new_global_trie_hash(hash, count_nodes); - chain_node = child_node; - do { - bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); - next_node = TrNode_next(chain_node); - TrNode_next(chain_node) = *bucket; - *bucket = chain_node; - chain_node = next_node; - } while (chain_node); - TrNode_child(parent_node) = (gt_node_ptr) hash; - } else { - TrNode_child(parent_node) = child_node; - } - UNLOCK_NODE(parent_node); - return child_node; - } - - { /* trie nodes with hashing */ - gt_hash_ptr hash; - gt_node_ptr *bucket; - int count_nodes = 0; - hash = (gt_hash_ptr) child_node; - bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash))); - child_node = *bucket; - while (child_node) { - if (TrNode_entry(child_node) == t) { - UNLOCK_NODE(parent_node); - return child_node; - } - count_nodes++; - child_node = TrNode_next(child_node); - } - new_global_trie_node(child_node, t, NULL, parent_node, *bucket); - *bucket = child_node; - Hash_num_nodes(hash)++; - count_nodes++; - if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { - /* expand current hash */ - gt_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; - int seed; - first_old_bucket = Hash_buckets(hash); - old_bucket = first_old_bucket + Hash_num_buckets(hash); - Hash_num_buckets(hash) *= 2; - ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); - seed = Hash_seed(hash); - do { - if (*--old_bucket) { - chain_node = *old_bucket; - do { - bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed)); - next_node = TrNode_next(chain_node); - TrNode_next(chain_node) = *bucket; - *bucket = chain_node; - chain_node = next_node; - } while (chain_node); - } - } while (old_bucket != first_old_bucket); - FREE_HASH_BUCKETS(first_old_bucket); - } - UNLOCK_NODE(parent_node); - return child_node; - } -} -#endif /* GLOBAL_TRIE */ - - -static inline -#ifdef GLOBAL_TRIE -sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, gt_node_ptr t) { -#else -sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { -#endif /* GLOBAL_TRIE */ +static inline sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { sg_node_ptr child_node; LOCK_NODE(parent_node); child_node = TrNode_child(parent_node); - if (child_node == NULL) { new_subgoal_trie_node(child_node, t, NULL, parent_node, NULL); TrNode_child(parent_node) = child_node; @@ -668,12 +605,7 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare } -static inline -#ifdef GLOBAL_TRIE -ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, gt_node_ptr t, int instr) { -#else -ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { -#endif /* GLOBAL_TRIE */ +static inline ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { ans_node_ptr child_node; #ifdef TABLING_ERRORS @@ -683,7 +615,6 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_ LOCK_NODE(parent_node); child_node = TrNode_child(parent_node); - if (child_node == NULL) { new_answer_trie_node(child_node, instr, t, NULL, parent_node, NULL); TrNode_child(parent_node) = child_node; @@ -773,521 +704,414 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_ #endif /* TABLE_LOCK_LEVEL */ - -/* -------------------------- ** -** Global functions ** -** -------------------------- */ - -sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { - int i, j, count_vars, arity; - CELL *stack_vars, *stack_terms_limit, *stack_terms_base, *stack_terms; - tab_ent_ptr tab_ent; - sg_fr_ptr sg_fr; #ifdef GLOBAL_TRIE - gt_node_ptr current_node; - sg_node_ptr current_sg_node; -#else - sg_node_ptr current_node; -#define current_sg_node current_node -#endif /* GLOBAL_TRIE */ +static inline gt_node_ptr global_trie_node_check_insert(gt_node_ptr parent_node, Term t) { + gt_node_ptr child_node; + + LOCK_NODE(parent_node); + child_node = TrNode_child(parent_node); + if (child_node == NULL) { + new_global_trie_node(child_node, t, NULL, parent_node, NULL); + TrNode_child(parent_node) = child_node; + UNLOCK_NODE(parent_node); + return child_node; + } - arity = preg->u.Otapl.s; - tab_ent = preg->u.Otapl.te; - count_vars = 0; - stack_vars = *Yaddr; - stack_terms_limit = (CELL *)TR; - stack_terms_base = stack_terms = (CELL *)Yap_TrailTop; - current_sg_node = TabEnt_subgoal_trie(tab_ent); -#ifdef TABLE_LOCK_AT_ENTRY_LEVEL - LOCK(TabEnt_lock(tab_ent)); -#endif /* TABLE_LOCK_LEVEL */ - for (i = 1; i <= arity; i++) { -#ifdef GLOBAL_TRIE - current_node = GLOBAL_root_gt; -#endif /* GLOBAL_TRIE */ - STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base); - STACK_PUSH_UP(Deref(XREGS[i]), stack_terms); + if (! IS_GLOBAL_TRIE_HASH(child_node)) { + int count_nodes = 0; do { - Term t = STACK_POP_DOWN(stack_terms); - if (IsVarTerm(t)) { - if (IsTableVarTerm(t)) { - t = MakeTableVarTerm(VarIndexOfTerm(t)); - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, t); - } else { - if (count_vars == MAX_TABLE_VARS) - Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (subgoal_search)"); - STACK_PUSH_UP(t, stack_vars); - *((CELL *)t) = GLOBAL_table_var_enumerator(count_vars); - t = MakeTableVarTerm(count_vars); - count_vars++; - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, t); - } - } else if (IsAtomOrIntTerm(t)) { - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, t); - } else if (IsPairTerm(t)) { + if (TrNode_entry(child_node) == t) { + UNLOCK_NODE(parent_node); + return child_node; + } + count_nodes++; + child_node = TrNode_next(child_node); + } while (child_node); + new_global_trie_node(child_node, t, NULL, parent_node, TrNode_child(parent_node)); + count_nodes++; + if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) { + /* alloc a new hash */ + gt_hash_ptr hash; + gt_node_ptr chain_node, next_node, *bucket; + new_global_trie_hash(hash, count_nodes); + chain_node = child_node; + do { + bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); + next_node = TrNode_next(chain_node); + TrNode_next(chain_node) = *bucket; + *bucket = chain_node; + chain_node = next_node; + } while (chain_node); + TrNode_child(parent_node) = (gt_node_ptr) hash; + } else { + TrNode_child(parent_node) = child_node; + } + UNLOCK_NODE(parent_node); + return child_node; + } + + { /* trie nodes with hashing */ + gt_hash_ptr hash; + gt_node_ptr *bucket; + int count_nodes = 0; + hash = (gt_hash_ptr) child_node; + bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash))); + child_node = *bucket; + while (child_node) { + if (TrNode_entry(child_node) == t) { + UNLOCK_NODE(parent_node); + return child_node; + } + count_nodes++; + child_node = TrNode_next(child_node); + } + new_global_trie_node(child_node, t, NULL, parent_node, *bucket); + *bucket = child_node; + Hash_num_nodes(hash)++; + count_nodes++; + if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { + /* expand current hash */ + gt_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; + int seed; + first_old_bucket = Hash_buckets(hash); + old_bucket = first_old_bucket + Hash_num_buckets(hash); + Hash_num_buckets(hash) *= 2; + ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); + seed = Hash_seed(hash); + do { + if (*--old_bucket) { + chain_node = *old_bucket; + do { + bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed)); + next_node = TrNode_next(chain_node); + TrNode_next(chain_node) = *bucket; + *bucket = chain_node; + chain_node = next_node; + } while (chain_node); + } + } while (old_bucket != first_old_bucket); + FREE_HASH_BUCKETS(first_old_bucket); + } + UNLOCK_NODE(parent_node); + return child_node; + } +} +#endif /* GLOBAL_TRIE */ + + +#ifndef GLOBAL_TRIE +static inline sg_node_ptr subgoal_search_subterm(tab_ent_ptr tab_ent, sg_node_ptr current_node, Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) { +#elif GLOBAL_TRIE_FOR_TERMS +static inline gt_node_ptr subgoal_search_subterm(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) { +#elif GLOBAL_TRIE_FOR_SUBTERMS +static gt_node_ptr subgoal_search_subterm(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr, CELL *stack_terms) { +#endif +#ifdef GLOBAL_TRIE + gt_node_ptr current_node = GLOBAL_root_gt; +#endif /* GLOBAL_TRIE */ + CELL *stack_terms_limit = (CELL *) TR; + int subs_arity = *subs_arity_ptr; + CELL *stack_vars = *stack_vars_ptr; +#ifndef GLOBAL_TRIE_FOR_SUBTERMS + CELL *stack_terms = (CELL *) Yap_TrailTop; +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); + STACK_PUSH_UP(NULL, stack_terms); + + do { + if (IsVarTerm(t)) { + if (IsTableVarTerm(t)) { + t = MakeTableVarTerm(VarIndexOfTerm(t)); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, t); + } else { + if (subs_arity == MAX_TABLE_VARS) + Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (subgoal_search_subterm)"); + STACK_PUSH_UP(t, stack_vars); + *((CELL *)t) = GLOBAL_table_var_enumerator(subs_arity); + t = MakeTableVarTerm(subs_arity); + subs_arity = subs_arity + 1; + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, t); + } + } else if (IsAtomOrIntTerm(t)) { + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, t); + } else if (IsPairTerm(t)) { #ifdef TRIE_COMPACT_PAIRS - CELL *aux = RepPair(t); - if (aux == PairTermMark) { - t = STACK_POP_DOWN(stack_terms); - if (IsPairTerm(t)) { - aux = RepPair(t); - t = Deref(*(aux + 1)); - if (t == TermNil) { - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairEndList); - } else { - /* STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2, stack_terms_base); */ - /* STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** - ** up 3 terms has already initially checked for the CompactPairInit term */ - STACK_PUSH_UP(t, stack_terms); - STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); - } - STACK_PUSH_UP(Deref(*aux), stack_terms); - } else { - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairEndTerm); - STACK_PUSH_UP(t, stack_terms); - } - } else { - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairInit); + CELL *aux = RepPair(t); + if (aux == PairTermMark) { + t = STACK_POP_DOWN(stack_terms); + if (IsPairTerm(t)) { + aux = RepPair(t); t = Deref(*(aux + 1)); if (t == TermNil) { - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairEndList); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairEndList); } else { - STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2, stack_terms_base); + /* AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); */ + /* AUX_STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** + ** up 3 terms has already initially checked for the CompactPairInit term */ STACK_PUSH_UP(t, stack_terms); STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); } STACK_PUSH_UP(Deref(*aux), stack_terms); - } -#else - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsPair(NULL)); - STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1, stack_terms_base); - STACK_PUSH_UP(Deref(*(RepPair(t) + 1)), stack_terms); - STACK_PUSH_UP(Deref(*(RepPair(t))), stack_terms); -#endif /* TRIE_COMPACT_PAIRS */ - } else if (IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); - if (f == FunctorDouble) { - volatile Float dbl = FloatOfTerm(t); - volatile Term *t_dbl = (Term *)((void *) &dbl); -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, *(t_dbl + 1)); -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, *t_dbl); -#ifdef GLOBAL_TRIE - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); -#endif /* GLOBAL_TRIE */ - } else if (f == FunctorLongInt) { - Int li = LongIntOfTerm(t); - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, li); -#ifdef GLOBAL_TRIE - SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); -#endif /* GLOBAL_TRIE */ - } else if (f == FunctorDBRef) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in subgoal_search)"); - } else if (f == FunctorBigInt) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in subgoal_search)"); } else { - STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1, stack_terms_base); - for (j = ArityOfFunctor(f); j >= 1; j--) - STACK_PUSH_UP(Deref(*(RepAppl(t) + j)), stack_terms); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairEndTerm); + STACK_PUSH_UP(t, stack_terms); } } else { - Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (subgoal_search)"); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairInit); + t = Deref(*(aux + 1)); + if (t == TermNil) { + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, CompactPairEndList); + } else { + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); + STACK_PUSH_UP(t, stack_terms); + STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); + } + STACK_PUSH_UP(Deref(*aux), stack_terms); } - } while (STACK_NOT_EMPTY(stack_terms, stack_terms_base)); +#else + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsPair(NULL)); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); + STACK_PUSH_UP(Deref(*(RepPair(t) + 1)), stack_terms); + STACK_PUSH_UP(Deref(*(RepPair(t))), stack_terms); +#endif /* TRIE_COMPACT_PAIRS */ + } else if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorDouble) { + volatile Float dbl = FloatOfTerm(t); + volatile Term *t_dbl = (Term *)((void *) &dbl); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, *(t_dbl + 1)); +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, *t_dbl); #ifdef GLOBAL_TRIE - current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, current_node); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); #endif /* GLOBAL_TRIE */ - } -#if defined(TABLE_LOCK_AT_NODE_LEVEL) - LOCK(TrNode_lock(current_sg_node)); -#elif defined(TABLE_LOCK_AT_WRITE_LEVEL) - LOCK_TABLE(current_sg_node); -#endif /* TABLE_LOCK_LEVEL */ - if (TrNode_sg_fr(current_sg_node) == NULL) { - /* new tabled subgoal */ - new_subgoal_frame(sg_fr, preg); - TrNode_sg_fr(current_sg_node) = (sg_node_ptr) sg_fr; - } else { - sg_fr = (sg_fr_ptr) TrNode_sg_fr(current_sg_node); -#ifdef LIMIT_TABLING - if (SgFr_state(sg_fr) <= ready) { /* incomplete or ready */ - remove_from_global_sg_fr_list(sg_fr); + } else if (f == FunctorLongInt) { + Int li = LongIntOfTerm(t); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, li); +#ifdef GLOBAL_TRIE + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); +#endif /* GLOBAL_TRIE */ + } else if (f == FunctorDBRef) { + Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in subgoal_search_subterm)"); + } else if (f == FunctorBigInt) { + Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in subgoal_search_subterm)"); + } else +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + if (current_node != GLOBAL_root_gt) { + gt_node_ptr subterm_node = subgoal_subterm_search(t, &subs_arity, &stack_vars, stack_terms); + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, (Term) subterm_node); + } else +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + { + int i; + SUBGOAL_TOKEN_CHECK_INSERT(tab_ent, current_node, AbsAppl((Term *)f)); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1); + for (i = ArityOfFunctor(f); i >= 1; i--) + STACK_PUSH_UP(Deref(*(RepAppl(t) + i)), stack_terms); + } + } else { + Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (subgoal_search_subterm)"); } -#endif /* LIMIT_TABLING */ - } -#if defined(TABLE_LOCK_AT_ENTRY_LEVEL) - UNLOCK(TabEnt_lock(tab_ent)); -#elif defined(TABLE_LOCK_AT_NODE_LEVEL) - UNLOCK(TrNode_lock(current_sg_node)); -#elif defined(TABLE_LOCK_AT_WRITE_LEVEL) - UNLOCK_TABLE(current_sg_node); -#endif /* TABLE_LOCK_LEVEL */ - - STACK_PUSH_UP(count_vars, stack_vars); - *Yaddr = stack_vars++; - /* reset variables */ - while (count_vars--) { - Term t = STACK_POP_DOWN(stack_vars); - RESET_VARIABLE(t); - } - - return sg_fr; -#ifndef GLOBAL_TRIE -#undef current_sg_node -#endif /* GLOBAL_TRIE */ + t = STACK_POP_DOWN(stack_terms); + } while (t); + + *subs_arity_ptr = subs_arity; + *stack_vars_ptr = stack_vars; + return current_node; } -ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { - int i, j, count_vars, subs_arity; - CELL *stack_vars, *stack_terms_base, *stack_terms; -#ifdef GLOBAL_TRIE - gt_node_ptr current_node; - ans_node_ptr current_ans_node; -#else - ans_node_ptr current_node; -#define current_ans_node current_node -#endif /* GLOBAL_TRIE */ +#ifndef GLOBAL_TRIE +static inline ans_node_ptr answer_search_subterm(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int *vars_arity_ptr) { +#elif GLOBAL_TRIE_FOR_TERMS +static inline gt_node_ptr answer_search_subterm(Term t, int *vars_arity_ptr) { +#elif GLOBAL_TRIE_FOR_SUBTERMS +static gt_node_ptr answer_search_subterm(Term t, int *vars_arity_ptr, CELL *stack_terms) { +#endif #ifdef TRIE_COMPACT_PAIRS int in_new_pair = 0; #else #define in_new_pair 0 #endif /* TRIE_COMPACT_PAIRS */ - - count_vars = 0; - subs_arity = *subs_ptr; - stack_vars = (CELL *)TR; - stack_terms_base = stack_terms = (CELL *)Yap_TrailTop; - current_ans_node = SgFr_answer_trie(sg_fr); - for (i = subs_arity; i >= 1; i--) { #ifdef GLOBAL_TRIE - current_node = GLOBAL_root_gt; + gt_node_ptr current_node = GLOBAL_root_gt; #endif /* GLOBAL_TRIE */ -#ifdef TABLING_ERRORS - if (IsNonVarTerm(*(subs_ptr + i))) - TABLING_ERROR_MESSAGE("IsNonVarTem(*(subs_ptr + i)) (answer_search)"); -#endif /* TABLING_ERRORS */ - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); - STACK_PUSH_UP(Deref(*(subs_ptr + i)), stack_terms); - do { - Term t = STACK_POP_DOWN(stack_terms); - if (IsVarTerm(t)) { - t = Deref(t); - if (IsTableVarTerm(t)) { - t = MakeTableVarTerm(VarIndexOfTerm(t)); - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, t, _trie_retry_val + in_new_pair); - } else { - if (count_vars == MAX_TABLE_VARS) - Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search)"); - STACK_PUSH_DOWN(t, stack_vars); - *((CELL *)t) = GLOBAL_table_var_enumerator(count_vars); - t = MakeTableVarTerm(count_vars); - count_vars++; - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, t, _trie_retry_var + in_new_pair); - } + int vars_arity = *vars_arity_ptr; +#ifndef GLOBAL_TRIE_FOR_SUBTERMS + CELL *stack_terms = (CELL *) Yap_TrailTop; +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + CELL *stack_vars = ((CELL *) TR) + vars_arity; + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars + 1); + STACK_PUSH_UP(NULL, stack_terms); + + do { + if (IsVarTerm(t)) { + t = Deref(t); + if (IsTableVarTerm(t)) { + t = MakeTableVarTerm(VarIndexOfTerm(t)); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, t, _trie_retry_val + in_new_pair); + } else { + if (vars_arity == MAX_TABLE_VARS) + Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search_subterm)"); + STACK_PUSH_DOWN(t, stack_vars); + *((CELL *)t) = GLOBAL_table_var_enumerator(vars_arity); + t = MakeTableVarTerm(vars_arity); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, t, _trie_retry_var + in_new_pair); + vars_arity = vars_arity + 1; + } #ifdef TRIE_COMPACT_PAIRS - in_new_pair = 0; + in_new_pair = 0; #endif /* TRIE_COMPACT_PAIRS */ - } else if (IsAtomOrIntTerm(t)) { - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, t, _trie_retry_atom + in_new_pair); + } else if (IsAtomOrIntTerm(t)) { + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, t, _trie_retry_atom + in_new_pair); #ifdef TRIE_COMPACT_PAIRS - in_new_pair = 0; + in_new_pair = 0; #endif /* TRIE_COMPACT_PAIRS */ - } else if (IsPairTerm(t)) { + } else if (IsPairTerm(t)) { #ifdef TRIE_COMPACT_PAIRS - CELL *aux = RepPair(t); - if (aux == PairTermMark) { - t = STACK_POP_DOWN(stack_terms); - if (IsPairTerm(t)) { - aux = RepPair(t); - t = Deref(*(aux + 1)); - if (t == TermNil) { - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); - } else { - /* STACK_CHECK_EXPAND(stack_terms, stack_vars + 2, stack_terms_base); */ - /* STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** - ** up 3 terms has already initially checked for the CompactPairInit term */ - STACK_PUSH_UP(t, stack_terms); - STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); - in_new_pair = 4; - } - STACK_PUSH_UP(Deref(*aux), stack_terms); - } else { - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairEndTerm, _trie_retry_null); - STACK_PUSH_UP(t, stack_terms); - } - } else { - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairInit, _trie_retry_null + in_new_pair); + CELL *aux = RepPair(t); + if (aux == PairTermMark) { + t = STACK_POP_DOWN(stack_terms); + if (IsPairTerm(t)) { + aux = RepPair(t); t = Deref(*(aux + 1)); if (t == TermNil) { - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); - in_new_pair = 0; + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); } else { - STACK_CHECK_EXPAND(stack_terms, stack_vars + 2, stack_terms_base); + /* AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars + 2); */ + /* AUX_STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** + ** up 3 terms has already initially checked for the CompactPairInit term */ STACK_PUSH_UP(t, stack_terms); STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); in_new_pair = 4; } STACK_PUSH_UP(Deref(*aux), stack_terms); - } -#else - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsPair(NULL), _trie_retry_pair); - STACK_CHECK_EXPAND(stack_terms, stack_vars + 1, stack_terms_base); - STACK_PUSH_UP(Deref(*(RepPair(t) + 1)), stack_terms); - STACK_PUSH_UP(Deref(*(RepPair(t))), stack_terms); -#endif /* TRIE_COMPACT_PAIRS */ - } else if (IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - if (f == FunctorDouble) { - volatile Float dbl = FloatOfTerm(t); - volatile Term *t_dbl = (Term *)((void *) &dbl); - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_new_pair); -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, *(t_dbl + 1), _trie_retry_extension); -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, *t_dbl, _trie_retry_extension); - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_float); - } else if (f == FunctorLongInt) { - Int li = LongIntOfTerm (t); - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_new_pair); - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, li, _trie_retry_extension); - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_long); - } else if (f == FunctorDBRef) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in answer_search)"); - } else if (f == FunctorBigInt) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in answer_search)"); } else { - ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_struct + in_new_pair); - STACK_CHECK_EXPAND(stack_terms, stack_vars + ArityOfFunctor(f) - 1, stack_terms_base); - for (j = ArityOfFunctor(f); j >= 1; j--) - STACK_PUSH_UP(Deref(*(RepAppl(t) + j)), stack_terms); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairEndTerm, _trie_retry_null); + STACK_PUSH_UP(t, stack_terms); + } + } else { + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairInit, _trie_retry_null + in_new_pair); + t = Deref(*(aux + 1)); + if (t == TermNil) { + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); + in_new_pair = 0; + } else { + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars + 2); + STACK_PUSH_UP(t, stack_terms); + STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); + in_new_pair = 4; + } + STACK_PUSH_UP(Deref(*aux), stack_terms); + } +#else + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsPair(NULL), _trie_retry_pair); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars + 1); + STACK_PUSH_UP(Deref(*(RepPair(t) + 1)), stack_terms); + STACK_PUSH_UP(Deref(*(RepPair(t))), stack_terms); +#endif /* TRIE_COMPACT_PAIRS */ + } else if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorDouble) { + volatile Float dbl = FloatOfTerm(t); + volatile Term *t_dbl = (Term *)((void *) &dbl); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_new_pair); +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, *(t_dbl + 1), _trie_retry_extension); +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, *t_dbl, _trie_retry_extension); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_float); + } else if (f == FunctorLongInt) { + Int li = LongIntOfTerm (t); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_new_pair); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, li, _trie_retry_extension); + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_long); + } else if (f == FunctorDBRef) { + Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in answer_search_subterm)"); + } else if (f == FunctorBigInt) { + Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in answer_search_subterm)"); + } else +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + if (current_node != GLOBAL_root_gt) { + gt_node_ptr subterm_node = answer_subterm_search(t, &vars_arity, stack_terms); + stack_vars = ((CELL *) TR) + vars_arity; + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, (Term) subterm_node, _trie_retry_struct + in_new_pair); + } else +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + { + int i; + ANSWER_TOKEN_CHECK_INSERT(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_struct + in_new_pair); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars + ArityOfFunctor(f) - 1); + for (i = ArityOfFunctor(f); i >= 1; i--) + STACK_PUSH_UP(Deref(*(RepAppl(t) + i)), stack_terms); } #ifdef TRIE_COMPACT_PAIRS - in_new_pair = 0; + in_new_pair = 0; #endif /* TRIE_COMPACT_PAIRS */ - } else { - Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search)"); - } - } while (STACK_NOT_EMPTY(stack_terms, stack_terms_base)); -#ifdef GLOBAL_TRIE - current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, current_node, _trie_retry_atom); -#endif /* GLOBAL_TRIE */ - } + + } else { + Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search_subterm)"); + } + t = STACK_POP_DOWN(stack_terms); + } while (t); - /* reset variables */ - while (count_vars--) { - Term t = STACK_POP_UP(stack_vars); - RESET_VARIABLE(t); - } - - return current_ans_node; -#ifndef GLOBAL_TRIE -#undef current_ans_node -#endif /* GLOBAL_TRIE */ + *vars_arity_ptr = vars_arity; + return current_node; #ifndef TRIE_COMPACT_PAIRS #undef in_new_pair #endif /* TRIE_COMPACT_PAIRS */ } -void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { - CELL *stack_vars_base, *stack_vars, *stack_terms_base, *stack_terms; - int i, subs_arity, vars_arity = 0; - Term t; -#ifdef GLOBAL_TRIE - gt_node_ptr current_node; -#else -#define current_node current_ans_node -#endif /* GLOBAL_TRIE */ +#ifndef GLOBAL_TRIE +static inline CELL *load_answer_subterm(ans_node_ptr current_node) { +#elif GLOBAL_TRIE_FOR_TERMS +static inline CELL *load_answer_subterm(gt_node_ptr current_node, int *vars_arity_ptr, CELL *stack_terms) { +#elif GLOBAL_TRIE_FOR_SUBTERMS +static CELL *load_answer_subterm(gt_node_ptr current_node, int *vars_arity_ptr, CELL *stack_terms) { +#endif #ifdef TRIE_COMPACT_PAIRS +#define stack_terms_base ((CELL *) Yap_TrailTop) int stack_terms_pair_offset = 0; #endif /* TRIE_COMPACT_PAIRS */ - - if ((subs_arity = *subs_ptr) == 0) - return; - -#ifdef TABLING_ERRORS - if (H < H_FZ) - TABLING_ERROR_MESSAGE("H < H_FZ (load_answer)"); -#endif /* TABLING_ERRORS */ - stack_vars_base = stack_vars = (CELL *)TR; - stack_terms_base = stack_terms = (CELL *)Yap_TrailTop; + CELL *stack_vars_base = (CELL *) TR; #ifdef GLOBAL_TRIE - for (i = subs_arity; i >= 1; i--) { - current_node = TrNode_entry(current_ans_node); - current_ans_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(current_ans_node)); - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); + int vars_arity = *vars_arity_ptr; + Term t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); #else - { - t = TrNode_entry(current_node); - current_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(current_node)); -#endif /* GLOBAL_TRIE */ - do { - if (IsVarTerm(t)) { - int var_index = VarIndexOfTableTerm(t); - STACK_CHECK_EXPAND(stack_terms, stack_vars_base + var_index + 1, stack_terms_base); + int vars_arity = 0; + CELL *stack_terms = (CELL *) Yap_TrailTop; + Term t = TrNode_entry(current_node); + current_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(current_node)); +#endif /* GLOBAL_TRIE */ + + do { + if (IsVarTerm(t)) { +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { + stack_terms = load_answer_subterm((gt_node_ptr) t, &vars_arity, stack_terms); + } else +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + { int var_index = VarIndexOfTableTerm(t); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars_base + var_index + 1); if (var_index >= vars_arity) { while (vars_arity < var_index) stack_vars_base[vars_arity++] = 0; stack_vars_base[vars_arity++] = MkVarTerm(); - stack_vars = stack_vars_base + vars_arity; } else if (stack_vars_base[var_index] == 0) stack_vars_base[var_index] = MkVarTerm(); STACK_PUSH_UP(stack_vars_base[var_index], stack_terms); - } else if (IsAtomOrIntTerm(t)) { - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); - STACK_PUSH_UP(t, stack_terms); - } else if (IsPairTerm(t)) { -#ifdef TRIE_COMPACT_PAIRS - if (t == CompactPairInit) { - Term *stack_aux = stack_terms_base - stack_terms_pair_offset; - Term head, tail = STACK_POP_UP(stack_aux); - while (STACK_NOT_EMPTY(stack_aux, stack_terms)) { - head = STACK_POP_UP(stack_aux); - tail = MkPairTerm(head, tail); - } - stack_terms = stack_terms_base - stack_terms_pair_offset; - stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms); - STACK_PUSH_UP(tail, stack_terms); - } else { /* CompactPairEndList / CompactPairEndTerm */ - Term last; - STACK_CHECK_EXPAND(stack_terms, stack_vars + 1, stack_terms_base); - last = STACK_POP_DOWN(stack_terms); - STACK_PUSH_UP(stack_terms_pair_offset, stack_terms); - stack_terms_pair_offset = (int) (stack_terms_base - stack_terms); - if (t == CompactPairEndList) - STACK_PUSH_UP(TermNil, stack_terms); - STACK_PUSH_UP(last, stack_terms); - } -#else - Term head = STACK_POP_DOWN(stack_terms); - Term tail = STACK_POP_DOWN(stack_terms); - t = MkPairTerm(head, tail); - STACK_PUSH_UP(t, stack_terms); -#endif /* TRIE_COMPACT_PAIRS */ - } else if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); - if (f == FunctorDouble) { - volatile Float dbl; - volatile Term *t_dbl = (Term *)((void *) &dbl); - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - *t_dbl = t; -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - *(t_dbl + 1) = t; -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - current_node = TrNode_parent(current_node); - t = MkFloatTerm(dbl); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); - STACK_PUSH_UP(t, stack_terms); - } else if (f == FunctorLongInt) { - Int li = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - current_node = TrNode_parent(current_node); - t = MkLongIntTerm(li); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); - STACK_PUSH_UP(t, stack_terms); - } else { - int f_arity = ArityOfFunctor(f); - t = Yap_MkApplTerm(f, f_arity, stack_terms); - stack_terms += f_arity; - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); - STACK_PUSH_UP(t, stack_terms); - } } - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - } while (current_node); - } - - for (i = subs_arity; i >= 1; i--) { - CELL *subs_var = (CELL *) *(subs_ptr + i); - t = STACK_POP_DOWN(stack_terms); - Bind(subs_var, t); - } - -#ifdef TABLING_ERRORS - if (stack_terms != (CELL *)Yap_TrailTop) - TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_answer)"); -#endif /* TABLING_ERRORS */ - - return; -#ifndef GLOBAL_TRIE -#undef current_node -#endif /* GLOBAL_TRIE */ -} - - -#ifdef GLOBAL_TRIE -CELL *load_substitution_variable(gt_node_ptr current_node, CELL *aux_stack_ptr) { - CELL *subs_ptr, *stack_terms_top, *stack_terms_base, *stack_terms; - int vars_arity; - Term t; -#ifdef TRIE_COMPACT_PAIRS - int stack_terms_pair_offset = 0; -#endif /* TRIE_COMPACT_PAIRS */ - - vars_arity = (int) *aux_stack_ptr; - stack_terms_top = (CELL *) TR; - stack_terms_base = stack_terms = (CELL *) Yap_TrailTop; - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - do { - if (IsVarTerm(t)) { - int var_index = VarIndexOfTableTerm(t); - t = MkVarTerm(); - if (var_index >= vars_arity) { - while (vars_arity < var_index) { - *aux_stack_ptr-- = 0; - vars_arity++; - } - *aux_stack_ptr-- = t; - vars_arity++; - *aux_stack_ptr = vars_arity; - } else { - /* do the same as in macro stack_trie_val_instr() */ - CELL aux_sub, aux_var, *vars_ptr; - vars_ptr = aux_stack_ptr + vars_arity - var_index; - aux_sub = *((CELL *) t); - aux_var = *vars_ptr; - if (aux_var == 0) { - *vars_ptr = t; - } else { - if (aux_sub > aux_var) { - if ((CELL *) aux_sub <= H) { - Bind_Global((CELL *) aux_sub, aux_var); - } else if ((CELL *) aux_var <= H) { - Bind_Local((CELL *) aux_sub, aux_var); - } else { - Bind_Local((CELL *) aux_var, aux_sub); - *vars_ptr = aux_sub; - } - } else { - if ((CELL *) aux_var <= H) { - Bind_Global((CELL *) aux_var, aux_sub); - *vars_ptr = aux_sub; - } else if ((CELL *) aux_sub <= H) { - Bind_Local((CELL *) aux_var, aux_sub); - *vars_ptr = aux_sub; - } else { - Bind_Local((CELL *) aux_sub, aux_var); - } - } - } - } - STACK_CHECK_EXPAND(stack_terms, stack_terms_top, stack_terms_base); - STACK_PUSH_UP(t, stack_terms); } else if (IsAtomOrIntTerm(t)) { - STACK_CHECK_EXPAND(stack_terms, stack_terms_top, stack_terms_base); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars_base + vars_arity); STACK_PUSH_UP(t, stack_terms); } else if (IsPairTerm(t)) { #ifdef TRIE_COMPACT_PAIRS - if (t == CompactPairInit) { + if (t == CompactPairInit) { Term *stack_aux = stack_terms_base - stack_terms_pair_offset; Term head, tail = STACK_POP_UP(stack_aux); while (STACK_NOT_EMPTY(stack_aux, stack_terms)) { @@ -1296,10 +1120,10 @@ CELL *load_substitution_variable(gt_node_ptr current_node, CELL *aux_stack_ptr) } stack_terms = stack_terms_base - stack_terms_pair_offset; stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms); - STACK_PUSH_UP(tail, stack_terms); + STACK_PUSH_UP(tail, stack_terms); } else { /* CompactPairEndList / CompactPairEndTerm */ Term last; - STACK_CHECK_EXPAND(stack_terms, stack_terms_top + 1, stack_terms_base); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars_base + vars_arity + 1); last = STACK_POP_DOWN(stack_terms); STACK_PUSH_UP(stack_terms_pair_offset, stack_terms); stack_terms_pair_offset = (int) (stack_terms_base - stack_terms); @@ -1328,20 +1152,20 @@ CELL *load_substitution_variable(gt_node_ptr current_node, CELL *aux_stack_ptr) #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ current_node = TrNode_parent(current_node); t = MkFloatTerm(dbl); - STACK_CHECK_EXPAND(stack_terms, stack_terms_top, stack_terms_base); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars_base + vars_arity); STACK_PUSH_UP(t, stack_terms); } else if (f == FunctorLongInt) { Int li = TrNode_entry(current_node); current_node = TrNode_parent(current_node); current_node = TrNode_parent(current_node); t = MkLongIntTerm(li); - STACK_CHECK_EXPAND(stack_terms, stack_terms_top, stack_terms_base); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars_base + vars_arity); STACK_PUSH_UP(t, stack_terms); } else { int f_arity = ArityOfFunctor(f); t = Yap_MkApplTerm(f, f_arity, stack_terms); stack_terms += f_arity; - STACK_CHECK_EXPAND(stack_terms, stack_terms_top, stack_terms_base); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_vars_base + vars_arity); STACK_PUSH_UP(t, stack_terms); } } @@ -1349,59 +1173,1027 @@ CELL *load_substitution_variable(gt_node_ptr current_node, CELL *aux_stack_ptr) current_node = TrNode_parent(current_node); } while (current_node); - subs_ptr = aux_stack_ptr + vars_arity + 1; - *subs_ptr = *subs_ptr - 1; - subs_ptr += *subs_ptr + 1; - t = STACK_POP_DOWN(stack_terms); - Bind((CELL *) *subs_ptr, t); +#ifdef GLOBAL_TRIE + *vars_arity_ptr = vars_arity; +#endif /* GLOBAL_TRIE */ + return stack_terms; +#ifdef TRIE_COMPACT_PAIRS +#undef stack_terms_base +#endif /* TRIE_COMPACT_PAIRS */ +} -#ifdef TABLING_ERRORS - if (stack_terms != (CELL *)Yap_TrailTop) - TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_substitution_variable)"); -#endif /* TABLING_ERRORS */ - return aux_stack_ptr; +#ifdef GLOBAL_TRIE +#ifdef GLOBAL_TRIE_FOR_TERMS +static inline CELL *load_substitution_variable_subterm(gt_node_ptr current_node, CELL **stack_vars_subs_ptr, CELL *stack_terms) { +#elif GLOBAL_TRIE_FOR_SUBTERMS +static CELL *load_substitution_variable_subterm(gt_node_ptr current_node, CELL **stack_vars_subs_ptr, CELL *stack_terms) { +#endif +#ifdef TRIE_COMPACT_PAIRS +#define stack_terms_base ((CELL *) Yap_TrailTop) + int stack_terms_pair_offset = 0; +#endif /* TRIE_COMPACT_PAIRS */ + CELL *stack_terms_limit = (CELL *) TR; + CELL *stack_vars_subs = *stack_vars_subs_ptr; + int vars_arity = *stack_vars_subs; + Term t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + + do { + if (IsVarTerm(t)) { +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { + gt_node_ptr temp_current_node = (gt_node_ptr) t; + stack_terms = load_substitution_variable_subterm(temp_current_node, &stack_vars_subs, stack_terms); + vars_arity = *stack_vars_subs; + } else +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + { + int var_index = VarIndexOfTableTerm(t); + t = MkVarTerm(); + if (var_index >= vars_arity) { + while (vars_arity < var_index) { + *stack_vars_subs-- = 0; + vars_arity++; + } + *stack_vars_subs-- = t; + vars_arity++; + *stack_vars_subs = vars_arity; + } else { + /* do the same as in macro stack_trie_val_instr() */ + CELL aux_sub, aux_var, *vars_ptr; + vars_ptr = stack_vars_subs + vars_arity - var_index; + aux_sub = *((CELL *) t); + aux_var = *vars_ptr; + if (aux_var == 0) { + *vars_ptr = t; + } else { + if (aux_sub > aux_var) { + if ((CELL *) aux_sub <= H) { + Bind_Global((CELL *) aux_sub, aux_var); + } else if ((CELL *) aux_var <= H) { + Bind_Local((CELL *) aux_sub, aux_var); + } else { + Bind_Local((CELL *) aux_var, aux_sub); + *vars_ptr = aux_sub; + } + } else { + if ((CELL *) aux_var <= H) { + Bind_Global((CELL *) aux_var, aux_sub); + *vars_ptr = aux_sub; + } else if ((CELL *) aux_sub <= H) { + Bind_Local((CELL *) aux_var, aux_sub); + *vars_ptr = aux_sub; + } else { + Bind_Local((CELL *) aux_sub, aux_var); + } + } + } + } + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); + } + } else if (IsAtomOrIntTerm(t)) { + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); + } else if (IsPairTerm(t)) { +#ifdef TRIE_COMPACT_PAIRS + if (t == CompactPairInit) { + Term *stack_aux = stack_terms_base - stack_terms_pair_offset; + Term head, tail = STACK_POP_UP(stack_aux); + while (STACK_NOT_EMPTY(stack_aux, stack_terms)) { + head = STACK_POP_UP(stack_aux); + tail = MkPairTerm(head, tail); + } + stack_terms = stack_terms_base - stack_terms_pair_offset; + stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms); + STACK_PUSH_UP(tail, stack_terms); + } else { /* CompactPairEndList / CompactPairEndTerm */ + Term last; + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); + last = STACK_POP_DOWN(stack_terms); + STACK_PUSH_UP(stack_terms_pair_offset, stack_terms); + stack_terms_pair_offset = (int) (stack_terms_base - stack_terms); + if (t == CompactPairEndList) + STACK_PUSH_UP(TermNil, stack_terms); + STACK_PUSH_UP(last, stack_terms); + } +#else + Term head = STACK_POP_DOWN(stack_terms); + Term tail = STACK_POP_DOWN(stack_terms); + t = MkPairTerm(head, tail); + STACK_PUSH_UP(t, stack_terms); +#endif /* TRIE_COMPACT_PAIRS */ + } else if (IsApplTerm(t)) { + Functor f = (Functor) RepAppl(t); + if (f == FunctorDouble) { + volatile Float dbl; + volatile Term *t_dbl = (Term *)((void *) &dbl); + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + *t_dbl = t; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + *(t_dbl + 1) = t; +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + current_node = TrNode_parent(current_node); + t = MkFloatTerm(dbl); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); + } else if (f == FunctorLongInt) { + Int li = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + current_node = TrNode_parent(current_node); + t = MkLongIntTerm(li); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); + } else { + int f_arity = ArityOfFunctor(f); + t = Yap_MkApplTerm(f, f_arity, stack_terms); + stack_terms += f_arity; + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); + } + } + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + } while (current_node); + + *stack_vars_subs_ptr = stack_vars_subs; + return stack_terms; +#ifdef TRIE_COMPACT_PAIRS +#undef stack_terms_base +#endif /* TRIE_COMPACT_PAIRS */ +} + + +static void free_global_trie_branch(gt_node_ptr current_node) { + gt_node_ptr parent_node, child_node; + + parent_node = TrNode_parent(current_node); + child_node = TrNode_child(parent_node); + if (IS_GLOBAL_TRIE_HASH(child_node)) { + gt_hash_ptr hash; + gt_node_ptr *bucket; + hash = (gt_hash_ptr) child_node; + Hash_num_nodes(hash)--; + bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(current_node), Hash_seed(hash))); + child_node = *bucket; + if (child_node != current_node) { + while (TrNode_next(child_node) != current_node) + child_node = TrNode_next(child_node); + TrNode_next(child_node) = TrNode_next(current_node); +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + Term t = TrNode_entry(current_node); + Term parent_t = TrNode_entry(parent_node); + if((Functor) RepAppl(parent_t) != FunctorDouble && IsVarTerm(t) && t > VarIndexOfTableTerm(MAX_TABLE_VARS)){ + DECREMENT_GLOBAL_TRIE_REFS(t); + } +#endif /* GLOBAL_TRIE_FOR_SUBTEMRS */ + FREE_GLOBAL_TRIE_NODE(current_node); + } else { + *bucket = TrNode_next(current_node); +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + Term t = TrNode_entry(current_node); + Term parent_t = TrNode_entry(parent_node); + if((Functor) RepAppl(parent_t) != FunctorDouble && IsVarTerm(t) && t > VarIndexOfTableTerm(MAX_TABLE_VARS)){ + DECREMENT_GLOBAL_TRIE_REFS(t); + } +#endif /* GLOBAL_TRIE_FOR_SUBTEMRS */ + FREE_GLOBAL_TRIE_NODE(current_node); + if (Hash_num_nodes(hash) == 0) { + FREE_HASH_BUCKETS(Hash_buckets(hash)); + FREE_GLOBAL_TRIE_HASH(hash); + if (parent_node != GLOBAL_root_gt) + free_global_trie_branch(parent_node); + else + TrNode_child(parent_node) = NULL; + } + } + } else if (child_node != current_node) { + while (TrNode_next(child_node) != current_node) + child_node = TrNode_next(child_node); + TrNode_next(child_node) = TrNode_next(current_node); +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + Term t = TrNode_entry(current_node); + Term parent_t = TrNode_entry(parent_node); + if((Functor) RepAppl(parent_t) != FunctorDouble && IsVarTerm(t) && t > VarIndexOfTableTerm(MAX_TABLE_VARS)){ + DECREMENT_GLOBAL_TRIE_REFS(t); + } +#endif /* GLOBAL_TRIE_FOR_SUBTEMRS */ + FREE_GLOBAL_TRIE_NODE(current_node); + } else if (TrNode_next(current_node) == NULL) { +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + Term t = TrNode_entry(current_node); + Term parent_t = TrNode_entry(parent_node); + if((Functor) RepAppl(parent_t) != FunctorDouble && IsVarTerm(t) && t > VarIndexOfTableTerm(MAX_TABLE_VARS)){ + DECREMENT_GLOBAL_TRIE_REFS(t); + } +#endif /* GLOBAL_TRIE_FOR_SUBTEMRS */ + FREE_GLOBAL_TRIE_NODE(current_node); + if (parent_node != GLOBAL_root_gt) + free_global_trie_branch(parent_node); + else + TrNode_child(parent_node) = NULL; + } else { + TrNode_child(parent_node) = TrNode_next(current_node); +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + Term t = TrNode_entry(current_node); + Term parent_t = TrNode_entry(parent_node); + if((Functor) RepAppl(parent_t) != FunctorDouble && IsVarTerm(t) && t > VarIndexOfTableTerm(MAX_TABLE_VARS)){ + DECREMENT_GLOBAL_TRIE_REFS(t); + } +#endif /* GLOBAL_TRIE_FOR_SUBTEMRS */ + FREE_GLOBAL_TRIE_NODE(current_node); + } + 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) + 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; +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + gt_node_ptr aux_child_node = TrNode_child(current_node); + if(aux_child_node != NULL && ((unsigned long int) aux_child_node)> MAX_UINT){ + //find a better way to express the secound coinditions or both + Functor child_f = (Functor) RepAppl(TrNode_entry(aux_child_node)); + if(child_f == FunctorLongInt || child_f == FunctorDouble) + SHOW_TABLE_STRUCTURE(" TERM (x%ld): %s\n", (unsigned long int) TrNode_child(aux_child_node), str); + } + else +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + SHOW_TABLE_STRUCTURE(" TERM (x%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_subgoal(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode) { + if (TrNode_parent(current_node) != GLOBAL_root_gt) + traverse_global_trie_for_subgoal(TrNode_parent(current_node), str, str_index, arity, mode); + traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, TRAVERSE_TYPE_SUBGOAL); + return; +} + + +static void traverse_global_trie_for_answer(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode) { + if (TrNode_parent(current_node) != GLOBAL_root_gt) + traverse_global_trie_for_answer(TrNode_parent(current_node), str, str_index, arity, mode); + traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, TRAVERSE_TYPE_ANSWER); + 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); +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 - 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; + if (arity[arity[0]] == -1) + str[str_index - 1] = '|'; +#endif /* TRIE_COMPACT_PAIRS */ + } + } while (++bucket != last_bucket); + free(current_arity); + return; } - /* adjust freeze registers */ - adjust_freeze_registers(); + /* 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++; +#ifdef GLOBAL_TRIE + traverse_global_trie_for_subgoal((gt_node_ptr)TrNode_entry(current_node), str, &str_index, arity, &mode); +#else + traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL); +#endif /* GLOBAL_TRIE */ + + /* continue with child node ... */ + if (arity[0] != 0) + 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++; +#ifdef GLOBAL_TRIE + traverse_global_trie_for_answer((gt_node_ptr)TrNode_entry(current_node), str, &str_index, arity, &mode); +#else + traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER); +#endif /* GLOBAL_TRIE */ + + /* 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 inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type) { + int mode = *mode_ptr; + int str_index = *str_index_ptr; + + /* test the node type */ + if (mode == TRAVERSE_MODE_FLOAT) { +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + arity[0]++; + arity[arity[0]] = (int) t; + mode = TRAVERSE_MODE_FLOAT2; + } else if (mode == TRAVERSE_MODE_FLOAT2) { + volatile Float dbl; + volatile Term *t_dbl = (Term *)((void *) &dbl); + *t_dbl = t; + *(t_dbl + 1) = (Term) arity[arity[0]]; + arity[0]--; +#else /* SIZEOF_DOUBLE == SIZEOF_INT_P */ + volatile Float dbl; + volatile Term *t_dbl = (Term *)((void *) &dbl); + *t_dbl = t; +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + str_index += sprintf(& str[str_index], "%.15g", dbl); + while (arity[0]) { + if (arity[arity[0]] > 0) { + arity[arity[0]]--; + if (arity[arity[0]] == 0) { + str_index += sprintf(& str[str_index], ")"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], ","); + break; + } + } else { + if (arity[arity[0]] == -2) { +#ifdef TRIE_COMPACT_PAIRS + str_index += sprintf(& str[str_index], ","); +#else + str_index += sprintf(& str[str_index], "|"); + arity[arity[0]] = -1; +#endif /* TRIE_COMPACT_PAIRS */ + break; + } else { + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } + } + } +#ifndef GLOBAL_TRIE + if (type == TRAVERSE_TYPE_SUBGOAL) + mode = TRAVERSE_MODE_NORMAL; + else /* type == TRAVERSE_TYPE_ANSWER */ +#endif /* GLOBAL_TRIE */ + mode = TRAVERSE_MODE_FLOAT_END; + } else if (mode == TRAVERSE_MODE_FLOAT_END) { + mode = TRAVERSE_MODE_NORMAL; + } else if (mode == TRAVERSE_MODE_LONG) { + Int li = (Int) t; +#if SHORT_INTS + str_index += sprintf(& str[str_index], "%ld", li); +#else + str_index += sprintf(& str[str_index], "%d", li); +#endif /* SHORT_INTS */ + while (arity[0]) { + if (arity[arity[0]] > 0) { + arity[arity[0]]--; + if (arity[arity[0]] == 0) { + str_index += sprintf(& str[str_index], ")"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], ","); + break; + } + } else { + if (arity[arity[0]] == -2) { +#ifdef TRIE_COMPACT_PAIRS + str_index += sprintf(& str[str_index], ","); +#else + str_index += sprintf(& str[str_index], "|"); + arity[arity[0]] = -1; +#endif /* TRIE_COMPACT_PAIRS */ + break; + } else { + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } + } + } +#ifndef GLOBAL_TRIE + if (type == TRAVERSE_TYPE_SUBGOAL) + mode = TRAVERSE_MODE_NORMAL; + else /* type == TRAVERSE_TYPE_ANSWER */ +#endif /* GLOBAL_TRIE */ + mode = TRAVERSE_MODE_LONG_END; + } else if (mode == TRAVERSE_MODE_LONG_END) { + mode = TRAVERSE_MODE_NORMAL; + } else if (IsVarTerm(t)) { +#ifdef GLOBAL_TRIE_FOR_SUBTERMS + if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { + if(type == TRAVERSE_TYPE_SUBGOAL) + traverse_global_trie_for_subgoal((gt_node_ptr) t, str, &str_index, arity, &mode); + else + traverse_global_trie_for_answer((gt_node_ptr) t, str, &str_index, arity, &mode); + } else +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + { + if (type == TRAVERSE_TYPE_SUBGOAL) + str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t)); + else /* type == TRAVERSE_TYPE_ANSWER */ + str_index += sprintf(& str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t)); + while (arity[0]) { + if (arity[arity[0]] > 0) { + arity[arity[0]]--; + if (arity[arity[0]] == 0) { + str_index += sprintf(& str[str_index], ")"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], ","); + break; + } + } else { + if (arity[arity[0]] == -2) { +#ifdef TRIE_COMPACT_PAIRS + str_index += sprintf(& str[str_index], ","); +#else + str_index += sprintf(& str[str_index], "|"); + arity[arity[0]] = -1; +#endif /* TRIE_COMPACT_PAIRS */ + break; + } else { + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } + } + } + } + } else if (IsIntTerm(t)) { +#if SHORT_INTS + str_index += sprintf(& str[str_index], "%ld", IntOfTerm(t)); +#else + str_index += sprintf(& str[str_index], "%d", IntOfTerm(t)); +#endif /* SHORT_INTS */ + while (arity[0]) { + if (arity[arity[0]] > 0) { + arity[arity[0]]--; + if (arity[arity[0]] == 0) { + str_index += sprintf(& str[str_index], ")"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], ","); + break; + } + } else { + if (arity[arity[0]] == -2) { +#ifdef TRIE_COMPACT_PAIRS + str_index += sprintf(& str[str_index], ","); +#else + str_index += sprintf(& str[str_index], "|"); + arity[arity[0]] = -1; +#endif /* TRIE_COMPACT_PAIRS */ + break; + } else { + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } + } + } + } else if (IsAtomTerm(t)) { +#ifndef TRIE_COMPACT_PAIRS + if (arity[arity[0]] == -1 && t == TermNil) { + str[str_index - 1] = ']'; + arity[0]--; + } else +#endif /* TRIE_COMPACT_PAIRS */ + str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t))); + while (arity[0]) { + if (arity[arity[0]] > 0) { + arity[arity[0]]--; + if (arity[arity[0]] == 0) { + str_index += sprintf(& str[str_index], ")"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], ","); + break; + } + } else { + if (arity[arity[0]] == -2) { +#ifdef TRIE_COMPACT_PAIRS + str_index += sprintf(& str[str_index], ","); +#else + str_index += sprintf(& str[str_index], "|"); + arity[arity[0]] = -1; +#endif /* TRIE_COMPACT_PAIRS */ + break; + } else { + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } + } + } + } else if (IsPairTerm(t)) { +#ifdef TRIE_COMPACT_PAIRS + if (t == CompactPairEndList) + arity[arity[0]] = -1; + else if (t == CompactPairEndTerm) { + str[str_index - 1] = '|'; + arity[arity[0]] = -1; +#else + if (arity[arity[0]] == -1) { + str[str_index - 1] = ','; + arity[arity[0]] = -2; +#endif /* TRIE_COMPACT_PAIRS */ + } else { + str_index += sprintf(& str[str_index], "["); + arity[0]++; + arity[arity[0]] = -2; + } + } else if (IsApplTerm(t)) { + Functor f = (Functor) RepAppl(t); + if (f == FunctorDouble) { + mode = TRAVERSE_MODE_FLOAT; + } else if (f == FunctorLongInt) { + mode = TRAVERSE_MODE_LONG; + } else { + str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f))); + arity[0]++; + arity[arity[0]] = ArityOfFunctor(f); + } + } + + *mode_ptr = mode; + *str_index_ptr = str_index; + return; +} + + +#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); + return; +} +#endif /* YAPOR */ + + + +/******************************* +** Global functions ** +*******************************/ + +sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { + CELL *stack_vars; + int i, subs_arity, pred_arity; + tab_ent_ptr tab_ent; + sg_fr_ptr sg_fr; + sg_node_ptr current_sg_node; + + stack_vars = *Yaddr; + subs_arity = 0; + pred_arity = preg->u.Otapl.s; + tab_ent = preg->u.Otapl.te; + current_sg_node = TabEnt_subgoal_trie(tab_ent); +#ifdef TABLE_LOCK_AT_ENTRY_LEVEL + LOCK(TabEnt_lock(tab_ent)); +#endif /* TABLE_LOCK_LEVEL */ + for (i = 1; i <= pred_arity; i++) { +#ifndef GLOBAL_TRIE + current_sg_node = subgoal_search_subterm(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars); +#else /* GLOBAL_TRIE */ + gt_node_ptr current_node; +#ifdef GLOBAL_TRIE_FOR_TERMS + current_node = subgoal_search_subterm(Deref(XREGS[i]), &subs_arity, &stack_vars); +#elif GLOBAL_TRIE_FOR_SUBTERMS + current_node = subgoal_search_subterm(Deref(XREGS[i]), &subs_arity, &stack_vars, (CELL *) Yap_TrailTop); +#endif + current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, (Term) current_node); +#endif + } + + STACK_PUSH_UP(subs_arity, stack_vars); + *Yaddr = stack_vars++; + /* reset variables */ + while (subs_arity--) { + Term t = STACK_POP_DOWN(stack_vars); + RESET_VARIABLE(t); + } + +#if defined(TABLE_LOCK_AT_NODE_LEVEL) + LOCK(TrNode_lock(current_sg_node)); +#elif defined(TABLE_LOCK_AT_WRITE_LEVEL) + LOCK_TABLE(current_sg_node); +#endif /* TABLE_LOCK_LEVEL */ + if (TrNode_sg_fr(current_sg_node) == NULL) { + /* new tabled subgoal */ + new_subgoal_frame(sg_fr, preg); + TrNode_sg_fr(current_sg_node) = (sg_node_ptr) sg_fr; + } else { + sg_fr = (sg_fr_ptr) TrNode_sg_fr(current_sg_node); +#ifdef LIMIT_TABLING + if (SgFr_state(sg_fr) <= ready) { /* incomplete or ready */ + remove_from_global_sg_fr_list(sg_fr); + } +#endif /* LIMIT_TABLING */ + } +#if defined(TABLE_LOCK_AT_ENTRY_LEVEL) + UNLOCK(TabEnt_lock(tab_ent)); +#elif defined(TABLE_LOCK_AT_NODE_LEVEL) + UNLOCK(TrNode_lock(current_sg_node)); +#elif defined(TABLE_LOCK_AT_WRITE_LEVEL) + UNLOCK_TABLE(current_sg_node); +#endif /* TABLE_LOCK_LEVEL */ + return sg_fr; +} + + +ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { +#define subs_arity *subs_ptr + CELL *stack_vars; + int i, vars_arity; + ans_node_ptr current_ans_node; + + vars_arity = 0; + current_ans_node = SgFr_answer_trie(sg_fr); + for (i = subs_arity; i >= 1; i--) { +#ifdef TABLING_ERRORS + if (IsNonVarTerm(subs_ptr[i])) + TABLING_ERROR_MESSAGE("IsNonVarTem(subs_ptr[i]) (answer_search)"); +#endif /* TABLING_ERRORS */ +#ifndef GLOBAL_TRIE + current_ans_node = answer_search_subterm(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity); +#else /* GLOBAL_TRIE */ + gt_node_ptr current_node; +#ifdef GLOBAL_TRIE_FOR_TERMS + current_node = answer_search_subterm(Deref(subs_ptr[i]), &vars_arity); +#elif GLOBAL_TRIE_FOR_SUBTERMS + current_node = answer_search_subterm(Deref(subs_ptr[i]), &vars_arity, (CELL *) Yap_TrailTop); +#endif + current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, (Term) current_node, _trie_retry_atom); +#endif + } + + /* reset variables */ + stack_vars = (CELL *) TR; + while (vars_arity--) { + Term t = STACK_POP_DOWN(stack_vars); + RESET_VARIABLE(t); + } + + return current_ans_node; +#undef subs_arity +} + + +void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { +#define subs_arity *subs_ptr + CELL *stack_terms; + int i; +#ifdef GLOBAL_TRIE + int vars_arity; +#endif /* GLOBAL_TRIE */ + +#ifdef TABLING_ERRORS + if (H < H_FZ) + TABLING_ERROR_MESSAGE("H < H_FZ (load_answer)"); +#endif /* TABLING_ERRORS */ + if (subs_arity == 0) + return; + +#ifndef GLOBAL_TRIE + stack_terms = load_answer_subterm(current_ans_node); +#else /* GLOBAL_TRIE */ + vars_arity = 0; + stack_terms = (CELL *) Yap_TrailTop; + for (i = subs_arity; i >= 1; i--) { + gt_node_ptr current_node = (gt_node_ptr) TrNode_entry(current_ans_node); + current_ans_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(current_ans_node)); + stack_terms = load_answer_subterm(current_node, &vars_arity, stack_terms); + } +#endif + + for (i = subs_arity; i >= 1; i--) { + CELL *subs_var = (CELL *) subs_ptr[i]; + Term t = STACK_POP_DOWN(stack_terms); + Bind(subs_var, t); + } +#ifdef TABLING_ERRORS + if (stack_terms != (CELL *)Yap_TrailTop) + TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_answer)"); +#endif /* TABLING_ERRORS */ + + return; +#undef subs_arity +} + + +#ifdef GLOBAL_TRIE +CELL *load_substitution_variable(gt_node_ptr current_node, CELL *stack_vars_subs) { + CELL *stack_terms, *subs_ptr; + Term t; + + stack_terms = load_substitution_variable_subterm(current_node, &stack_vars_subs, (CELL *) Yap_TrailTop); + t = STACK_POP_DOWN(stack_terms); +#ifdef TABLING_ERRORS + if (stack_terms != (CELL *)Yap_TrailTop) + TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_substitution_variable)"); +#endif /* TABLING_ERRORS */ + subs_ptr = stack_vars_subs + *stack_vars_subs + 1; + *subs_ptr = *subs_ptr - 1; + subs_ptr += *subs_ptr + 1; + Bind((CELL *) *subs_ptr, t); + + return stack_vars_subs; +} +#endif /* GLOBAL_TRIE */ + + #ifdef GLOBAL_TRIE void free_subgoal_trie_branch(sg_node_ptr current_node, int nodes_left, int position) { if (nodes_left) { @@ -1547,41 +2339,6 @@ void update_answer_trie(sg_fr_ptr sg_fr) { } -static struct trie_statistics{ - int show; - long subgoals; - long subgoals_incomplete; - long subgoal_trie_nodes; - long answers; -#ifdef TABLING_INNER_CUTS - long answers_pruned; -#endif /* TABLING_INNER_CUTS */ - long answers_true; - long answers_no; - long answer_trie_nodes; -#ifdef GLOBAL_TRIE - long global_trie_terms; - long global_trie_nodes; -#endif /* GLOBAL_TRIE */ -} trie_stats; - -#define TrStat_show trie_stats.show -#define TrStat_subgoals trie_stats.subgoals -#define TrStat_sg_incomplete trie_stats.subgoals_incomplete -#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes -#define TrStat_answers trie_stats.answers -#define TrStat_answers_true trie_stats.answers_true -#define TrStat_answers_no trie_stats.answers_no -#define TrStat_answers_pruned trie_stats.answers_pruned -#define TrStat_ans_nodes trie_stats.answer_trie_nodes -#define TrStat_gt_terms trie_stats.global_trie_terms -#define TrStat_gt_nodes trie_stats.global_trie_nodes - -#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) if (TrStat_show == SHOW_MODE_STRUCTURE) fprintf(Yap_stdout, MESG, ##ARGS) -#define STR_ARRAY_SIZE 100000 -#define ARITY_ARRAY_SIZE 10000 - - void show_table(tab_ent_ptr tab_ent, int show_mode) { sg_node_ptr sg_node; @@ -1604,9 +2361,9 @@ void show_table(tab_ent_ptr tab_ent, int show_mode) { sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent)); if (sg_node) { if (TabEnt_arity(tab_ent)) { - char *str = (char *) malloc(sizeof(char) * STR_ARRAY_SIZE); + char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE); int str_index = sprintf(str, " ?- %s(", AtomName(TabEnt_atom(tab_ent))); - int *arity = (int *) malloc(sizeof(int) * ARITY_ARRAY_SIZE); + int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE); arity[0] = 1; arity[1] = TabEnt_arity(tab_ent); traverse_subgoal_trie(sg_node, str, str_index, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST); @@ -1660,8 +2417,8 @@ void show_global_trie(void) { TrStat_gt_nodes = 1; fprintf(Yap_stdout, "Global trie structure\n"); if (TrNode_child(GLOBAL_root_gt)) { - char *str = (char *) malloc(sizeof(char) * STR_ARRAY_SIZE); - int *arity = (int *) malloc(sizeof(int) * ARITY_ARRAY_SIZE); + char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE); + int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE); arity[0] = 0; traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST); free(str); @@ -1677,658 +2434,42 @@ void show_global_trie(void) { #endif /* GLOBAL_TRIE */ - -/* ------------------------- ** -** Local functions ** -** ------------------------- */ - -#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; - } +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); } -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; -} + 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 -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)); + while (LOCAL_top_sg_fr != sg_fr) { + mark_as_completed(LOCAL_top_sg_fr); + LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr); } - 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 /* TABLING_INNER_CUTS */ -#else /* TABLING */ -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 */ + mark_as_completed(LOCAL_top_sg_fr); + LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr); +#endif /* LIMIT_TABLING */ - -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; + /* 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; } - /* 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++; -#ifdef GLOBAL_TRIE - traverse_global_trie_for_subgoal(TrNode_entry(current_node), str, &str_index, arity, &mode); -#else - traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL); -#endif /* GLOBAL_TRIE */ - - /* continue with child node ... */ - if (arity[0] != 0) - 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); - } + /* adjust freeze registers */ + adjust_freeze_registers(); 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++; -#ifdef GLOBAL_TRIE - traverse_global_trie_for_answer(TrNode_entry(current_node), str, &str_index, arity, &mode); -#else - traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER); -#endif /* GLOBAL_TRIE */ - - /* 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_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type) { - int mode = *mode_ptr; - int str_index = *str_index_ptr; - - /* test the node type */ - if (mode == TRAVERSE_MODE_FLOAT) { -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - arity[0]++; - arity[arity[0]] = (int) t; - mode = TRAVERSE_MODE_FLOAT2; - } else if (mode == TRAVERSE_MODE_FLOAT2) { - volatile Float dbl; - volatile Term *t_dbl = (Term *)((void *) &dbl); - *t_dbl = t; - *(t_dbl + 1) = (Term) arity[arity[0]]; - arity[0]--; -#else /* SIZEOF_DOUBLE == SIZEOF_INT_P */ - volatile Float dbl; - volatile Term *t_dbl = (Term *)((void *) &dbl); - *t_dbl = t; -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - str_index += sprintf(& str[str_index], "%.15g", dbl); - while (arity[0]) { - if (arity[arity[0]] > 0) { - arity[arity[0]]--; - if (arity[arity[0]] == 0) { - str_index += sprintf(& str[str_index], ")"); - arity[0]--; - } else { - str_index += sprintf(& str[str_index], ","); - break; - } - } else { - if (arity[arity[0]] == -2) { -#ifdef TRIE_COMPACT_PAIRS - str_index += sprintf(& str[str_index], ","); -#else - str_index += sprintf(& str[str_index], "|"); - arity[arity[0]] = -1; -#endif /* TRIE_COMPACT_PAIRS */ - break; - } else { - str_index += sprintf(& str[str_index], "]"); - arity[0]--; - } - } - } -#ifndef GLOBAL_TRIE - if (type == TRAVERSE_TYPE_SUBGOAL) - mode = TRAVERSE_MODE_NORMAL; - else /* type == TRAVERSE_TYPE_ANSWER */ -#endif /* GLOBAL_TRIE */ - mode = TRAVERSE_MODE_FLOAT_END; - } else if (mode == TRAVERSE_MODE_FLOAT_END) { - mode = TRAVERSE_MODE_NORMAL; - } else if (mode == TRAVERSE_MODE_LONG) { - Int li = (Int) t; -#if SHORT_INTS - str_index += sprintf(& str[str_index], "%ld", li); -#else - str_index += sprintf(& str[str_index], "%d", li); -#endif /* SHORT_INTS */ - while (arity[0]) { - if (arity[arity[0]] > 0) { - arity[arity[0]]--; - if (arity[arity[0]] == 0) { - str_index += sprintf(& str[str_index], ")"); - arity[0]--; - } else { - str_index += sprintf(& str[str_index], ","); - break; - } - } else { - if (arity[arity[0]] == -2) { -#ifdef TRIE_COMPACT_PAIRS - str_index += sprintf(& str[str_index], ","); -#else - str_index += sprintf(& str[str_index], "|"); - arity[arity[0]] = -1; -#endif /* TRIE_COMPACT_PAIRS */ - break; - } else { - str_index += sprintf(& str[str_index], "]"); - arity[0]--; - } - } - } -#ifndef GLOBAL_TRIE - if (type == TRAVERSE_TYPE_SUBGOAL) - mode = TRAVERSE_MODE_NORMAL; - else /* type == TRAVERSE_TYPE_ANSWER */ -#endif /* GLOBAL_TRIE */ - mode = TRAVERSE_MODE_LONG_END; - } else if (mode == TRAVERSE_MODE_LONG_END) { - mode = TRAVERSE_MODE_NORMAL; - } else if (IsVarTerm(t)) { - if (type == TRAVERSE_TYPE_SUBGOAL) - str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t)); - else /* type == TRAVERSE_TYPE_ANSWER */ - str_index += sprintf(& str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t)); - while (arity[0]) { - if (arity[arity[0]] > 0) { - arity[arity[0]]--; - if (arity[arity[0]] == 0) { - str_index += sprintf(& str[str_index], ")"); - arity[0]--; - } else { - str_index += sprintf(& str[str_index], ","); - break; - } - } else { - if (arity[arity[0]] == -2) { -#ifdef TRIE_COMPACT_PAIRS - str_index += sprintf(& str[str_index], ","); -#else - str_index += sprintf(& str[str_index], "|"); - arity[arity[0]] = -1; -#endif /* TRIE_COMPACT_PAIRS */ - break; - } else { - str_index += sprintf(& str[str_index], "]"); - arity[0]--; - } - } - } - } else if (IsIntTerm(t)) { -#if SHORT_INTS - str_index += sprintf(& str[str_index], "%ld", IntOfTerm(t)); -#else - str_index += sprintf(& str[str_index], "%d", IntOfTerm(t)); -#endif /* SHORT_INTS */ - while (arity[0]) { - if (arity[arity[0]] > 0) { - arity[arity[0]]--; - if (arity[arity[0]] == 0) { - str_index += sprintf(& str[str_index], ")"); - arity[0]--; - } else { - str_index += sprintf(& str[str_index], ","); - break; - } - } else { - if (arity[arity[0]] == -2) { -#ifdef TRIE_COMPACT_PAIRS - str_index += sprintf(& str[str_index], ","); -#else - str_index += sprintf(& str[str_index], "|"); - arity[arity[0]] = -1; -#endif /* TRIE_COMPACT_PAIRS */ - break; - } else { - str_index += sprintf(& str[str_index], "]"); - arity[0]--; - } - } - } - } else if (IsAtomTerm(t)) { -#ifndef TRIE_COMPACT_PAIRS - if (arity[arity[0]] == -1 && t == TermNil) { - str[str_index - 1] = ']'; - arity[0]--; - } else -#endif /* TRIE_COMPACT_PAIRS */ - str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t))); - while (arity[0]) { - if (arity[arity[0]] > 0) { - arity[arity[0]]--; - if (arity[arity[0]] == 0) { - str_index += sprintf(& str[str_index], ")"); - arity[0]--; - } else { - str_index += sprintf(& str[str_index], ","); - break; - } - } else { - if (arity[arity[0]] == -2) { -#ifdef TRIE_COMPACT_PAIRS - str_index += sprintf(& str[str_index], ","); -#else - str_index += sprintf(& str[str_index], "|"); - arity[arity[0]] = -1; -#endif /* TRIE_COMPACT_PAIRS */ - break; - } else { - str_index += sprintf(& str[str_index], "]"); - arity[0]--; - } - } - } - } else if (IsPairTerm(t)) { -#ifdef TRIE_COMPACT_PAIRS - if (t == CompactPairEndList) - arity[arity[0]] = -1; - else if (t == CompactPairEndTerm) { - str[str_index - 1] = '|'; - arity[arity[0]] = -1; -#else - if (arity[arity[0]] == -1) { - str[str_index - 1] = ','; - arity[arity[0]] = -2; -#endif /* TRIE_COMPACT_PAIRS */ - } else { - str_index += sprintf(& str[str_index], "["); - arity[0]++; - arity[arity[0]] = -2; - } - } else if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); - if (f == FunctorDouble) { - mode = TRAVERSE_MODE_FLOAT; - } else if (f == FunctorLongInt) { - mode = TRAVERSE_MODE_LONG; - } else { - str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f))); - arity[0]++; - arity[arity[0]] = ArityOfFunctor(f); - } - } - - *mode_ptr = mode; - *str_index_ptr = str_index; - return; -} - - -#ifdef GLOBAL_TRIE -static -void free_global_trie_branch(gt_node_ptr current_node) { - gt_node_ptr parent_node, child_node; - - parent_node = TrNode_parent(current_node); - child_node = TrNode_child(parent_node); - if (IS_GLOBAL_TRIE_HASH(child_node)) { - gt_hash_ptr hash; - gt_node_ptr *bucket; - hash = (gt_hash_ptr) child_node; - Hash_num_nodes(hash)--; - bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(current_node), Hash_seed(hash))); - child_node = *bucket; - if (child_node != current_node) { - while (TrNode_next(child_node) != current_node) - child_node = TrNode_next(child_node); - TrNode_next(child_node) = TrNode_next(current_node); - FREE_GLOBAL_TRIE_NODE(current_node); - } else { - *bucket = TrNode_next(current_node); - FREE_GLOBAL_TRIE_NODE(current_node); - if (Hash_num_nodes(hash) == 0) { - FREE_HASH_BUCKETS(Hash_buckets(hash)); - FREE_GLOBAL_TRIE_HASH(hash); - if (parent_node != GLOBAL_root_gt) - free_global_trie_branch(parent_node); - else - TrNode_child(parent_node) = NULL; - } - } - } else if (child_node != current_node) { - while (TrNode_next(child_node) != current_node) - child_node = TrNode_next(child_node); - TrNode_next(child_node) = TrNode_next(current_node); - FREE_GLOBAL_TRIE_NODE(current_node); - } else if (TrNode_next(current_node) == NULL) { - FREE_GLOBAL_TRIE_NODE(current_node); - if (parent_node != GLOBAL_root_gt) - free_global_trie_branch(parent_node); - else - TrNode_child(parent_node) = NULL; - } else { - TrNode_child(parent_node) = TrNode_next(current_node); - FREE_GLOBAL_TRIE_NODE(current_node); - } - 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) - 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(" TERM (x%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_subgoal(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode) { - if (TrNode_parent(current_node) != GLOBAL_root_gt) - traverse_global_trie_for_subgoal(TrNode_parent(current_node), str, str_index, arity, mode); - traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, TRAVERSE_TYPE_SUBGOAL); - return; -} - - -static -void traverse_global_trie_for_answer(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode) { - if (TrNode_parent(current_node) != GLOBAL_root_gt) - traverse_global_trie_for_answer(TrNode_parent(current_node), str, str_index, arity, mode); - traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, TRAVERSE_TYPE_ANSWER); - return; -} -#endif /* GLOBAL_TRIE */ #endif /* TABLING */ + + + diff --git a/OPTYap/tab.tries.insts.i b/OPTYap/tab.tries.insts.i index 20eea41c2..6e2d28b30 100644 --- a/OPTYap/tab.tries.insts.i +++ b/OPTYap/tab.tries.insts.i @@ -1,70 +1,74 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: tab.tries.insts.i - version: $Id: tab.tries.insts.i,v 1.12 2007-04-26 14:11:08 ricroc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* --------------------------------------------------------- ** -** Trie instructions: auxiliary stack organization ** -** --------------------------------------------------------- ** - STANDARD_TRIE - ------------------- - | ha = heap_arity | - ------------------- -- - | heap ptr 1 | | - ------------------- | - | ... | -- heap_arity - ------------------- | - | heap ptr ha | | - ------------------- -- - | va = vars_arity | - ------------------- - | sa = subs_arity | - ------------------- -- - | subs ptr sa | | - ------------------- | - | ... | -- subs_arity - ------------------- | - | subs ptr 1 | | - ------------------- -- - | var ptr va | | - ------------------- | - | ... | -- vars_arity - ------------------- | - | var ptr 1 | | - ------------------- -- +/************************************************************************ +** Trie instructions: auxiliary stack organization ** +************************************************************************* + + STANDARD_TRIE + ------------------- + | ha = heap_arity | + ------------------- -- + | heap ptr 1 | | + ------------------- | + | ... | -- heap_arity + ------------------- | + | heap ptr ha | | + ------------------- -- + | va = vars_arity | + ------------------- + | sa = subs_arity | + ------------------- -- + | subs ptr sa | | + ------------------- | + | ... | -- subs_arity + ------------------- | + | subs ptr 1 | | + ------------------- -- + | var ptr va | | + ------------------- | + | ... | -- vars_arity + ------------------- | + | var ptr 1 | | + ------------------- -- - GLOBAL_TRIE - ------------------- - | va = vars_arity | - ------------------- -- - | var ptr va | | - ------------------- | - | ... | -- vars_arity - ------------------- | - | var ptr 1 | | - ------------------- -- - | sa = subs_arity | - ------------------- -- - | subs ptr sa | | - ------------------- | - | ... | -- subs_arity - ------------------- | - | subs ptr 1 | | - ------------------- -- -** --------------------------------------------------------- */ + GLOBAL_TRIE + ------------------- + | va = vars_arity | + ------------------- -- + | var ptr va | | + ------------------- | + | ... | -- vars_arity + ------------------- | + | var ptr 1 | | + ------------------- -- + | sa = subs_arity | + ------------------- -- + | subs ptr sa | | + ------------------- | + | ... | -- subs_arity + ------------------- | + | subs ptr 1 | | + ------------------- -- + +************************************************************************/ -/* --------------------------------------------- ** -** Trie instructions: auxiliary macros ** -** --------------------------------------------- */ +/************************************************************************ +** Trie instructions: auxiliary macros ** +************************************************************************/ #ifdef GLOBAL_TRIE #define copy_arity_stack() \ @@ -98,12 +102,8 @@ PREFETCH_OP(PREG); \ GONext() - - -/* ---------------------------------------------------------------------------- ** -** the 'store_trie_node', 'restore_trie_node' and 'pop_trie_node' macros do not ** -** include the 'set_cut' macro because there are no cuts in trie instructions. ** -** ---------------------------------------------------------------------------- */ +/* the 'store_trie_node', 'restore_trie_node' and 'pop_trie_node' macros do not ** +** include the 'set_cut' macro because there are no cuts in trie instructions */ #define store_trie_node(AP) \ { register choiceptr cp; \ @@ -162,15 +162,15 @@ -/* ------------------- ** -** trie_null ** -** ------------------- */ +/************************************************************************ +** trie_null ** +************************************************************************/ #define stack_trie_null_instr() \ next_trie_instruction(node) #ifdef TRIE_COMPACT_PAIRS -/* trie compiled code for term 'CompactPairInit' */ +/* trie compiled code for term 'CompactPairInit' */ #define stack_trie_null_in_new_pair_instr() \ if (heap_arity) { \ aux_stack_ptr++; \ @@ -200,9 +200,9 @@ -/* ------------------ ** -** trie_var ** -** ------------------ */ +/************************************************************************ +** trie_var ** +************************************************************************/ #define stack_trie_var_instr() \ if (heap_arity) { \ @@ -267,9 +267,9 @@ -/* ------------------ ** -** trie_val ** -** ------------------ */ +/************************************************************************ +** trie_val ** +************************************************************************/ #define stack_trie_val_instr() \ if (heap_arity) { \ @@ -371,9 +371,9 @@ -/* ------------------- ** -** trie_atom ** -** ------------------- */ +/************************************************************************ +** trie_atom ** +************************************************************************/ #define stack_trie_atom_instr() \ if (heap_arity) { \ @@ -421,12 +421,12 @@ -/* ------------------- ** -** trie_pair ** -** ------------------- */ +/************************************************************************ +** trie_pair ** +************************************************************************/ #ifdef TRIE_COMPACT_PAIRS -/* trie compiled code for term 'CompactPairEndList' */ +/* trie compiled code for term 'CompactPairEndList' */ #define stack_trie_pair_instr() \ if (heap_arity) { \ aux_stack_ptr++; \ @@ -479,9 +479,9 @@ -/* --------------------- ** -** trie_struct ** -** --------------------- */ +/************************************************************************ +** trie_struct ** +************************************************************************/ #define stack_trie_struct_instr() \ if (heap_arity) { \ @@ -547,9 +547,9 @@ -/* ------------------------ ** -** trie_extension ** -** ------------------------ */ +/************************************************************************ +** trie_extension ** +************************************************************************/ #define stack_trie_extension_instr() \ *aux_stack_ptr-- = 0; /* float/longint extension mark */ \ @@ -560,9 +560,9 @@ -/* ---------------------------- ** -** trie_float_longint ** -** ---------------------------- */ +/************************************************************************ +** trie_float_longint ** +************************************************************************/ #define stack_trie_float_longint_instr() \ if (heap_arity) { \ @@ -587,9 +587,9 @@ -/* --------------------------- ** -** Trie instructions ** -** --------------------------- */ +/************************************************************************ +** Trie instructions ** +************************************************************************/ PBOp(trie_do_null, e) #ifndef GLOBAL_TRIE @@ -978,7 +978,7 @@ register CELL *aux_stack_ptr = YENV; #ifdef GLOBAL_TRIE int subs_arity = *(aux_stack_ptr + *aux_stack_ptr + 1); - YENV = aux_stack_ptr = load_substitution_variable(TrNode_entry(node), aux_stack_ptr); + YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); next_instruction(subs_arity - 1 , node); #else int heap_arity = *aux_stack_ptr; @@ -1003,7 +1003,7 @@ #endif /* GLOBAL_TRIE */ pop_trie_node(); #ifdef GLOBAL_TRIE - YENV = aux_stack_ptr = load_substitution_variable(TrNode_entry(node), aux_stack_ptr); + YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); next_instruction(subs_arity - 1 , node); #else stack_trie_atom_instr(); @@ -1024,7 +1024,7 @@ #endif /* GLOBAL_TRIE */ store_trie_node(TrNode_next(node)); #ifdef GLOBAL_TRIE - YENV = aux_stack_ptr = load_substitution_variable(TrNode_entry(node), aux_stack_ptr); + YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); next_instruction(subs_arity - 1, node); #else stack_trie_atom_instr(); @@ -1045,7 +1045,7 @@ #endif /* GLOBAL_TRIE */ restore_trie_node(TrNode_next(node)); #ifdef GLOBAL_TRIE - YENV = aux_stack_ptr = load_substitution_variable(TrNode_entry(node), aux_stack_ptr); + YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); next_instruction(subs_arity - 1, node); #else stack_trie_atom_instr(); diff --git a/OPTYap/x86_locks.h b/OPTYap/x86_locks.h index b599f98c6..38b7e0bb9 100644 --- a/OPTYap/x86_locks.h +++ b/OPTYap/x86_locks.h @@ -1,17 +1,19 @@ -/********************************************************************** - - The OPTYap Prolog system - OPTYap extends the Yap Prolog system to support or-parallel tabling - - Copyright: R. Rocha and NCC - University of Porto, Portugal - File: x86_locks.h - version: $Id: x86_locks.h,v 1.4 2007-11-26 23:43:09 vsc Exp $ - -**********************************************************************/ +/************************************************************************ +** ** +** 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 ** +** ** +************************************************************************/ -/* ----------------------------- ** -** Atomic lock for X86 ** -** ----------------------------- */ +/************************************************************************ +** Atomic locks for X86 ** +************************************************************************/ typedef struct { volatile unsigned int lock;