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

This commit was generated by cvs2svn to compensate for changes in r4,

Browse Source 
which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2001-04-09 19:54:03 +00:00
parent 9a8ee05f1f
commit e5f4633c39
457 changed files with 189536 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
OPTYap/alpha_locks.h Normal file
View File

@@ -0,0 +1,39 @@
/* ------------------------------- **
** Atomic lock for ALPHA **
** ------------------------------- */
/* This code is stolen from the Linux kernel */
typedef struct { unsigned long a[100]; } __dummy_lock_t;
#define __dummy_lock(lock) (*(__dummy_lock_t *)(lock))
/*
Memory barrier in Alpha machines
*/
#define mb() \
__asm__ __volatile__("mb": : :"memory")
#define INIT_LOCK(LOCK_VAR) ((LOCK_VAR) = 0)
#define TRY_LOCK(LOCK_PTR) (!_test_and_set_bit(0,(volatile void *)(LOCK_PTR)))
#define LOCK(LOCK_VAR) _spin_lock((volatile void *)&(LOCK_VAR))
#define IS_LOCKED(LOCK_VAR) ((LOCK_VAR) != 0)
#define IS_UNLOCKED(LOCK_VAR) ((LOCK_VAR) == 0)
/* We need to support a memory barrier on Alphas */
#define UNLOCK(LOCK_VAR) { mb(); LOCK_VAR = 0; }
typedef struct {
volatile int write_lock:1, read_counter:31;
} /*__attribute__((aligned(32)))*/ rwlock_t;
#define RW_LOCK_UNLOCKED (rwlock_t) { 0, 0 }
#define READ_LOCK(X) _read_lock(&(X))
#define READ_UNLOCK(X) _read_unlock(&(X))
#define WRITE_LOCK(X) _write_lock(&(X))
#define WRITE_UNLOCK(X) _write_unlock(&(X))
#define INIT_RWLOCK(RW) (RW) = RW_LOCK_UNLOCKED

118
OPTYap/alpha_locks_funcs.h Normal file
View File

@@ -0,0 +1,118 @@
/* ------------------------------- **
** Atomic lock for ALPHA **
** ------------------------------- */
/* This code is stolen from the Linux kernel */
static __inline__ int _test_and_set_bit(unsigned long nr,
volatile void * addr)
{
unsigned long oldbit;
unsigned long temp;
unsigned int * m = ((unsigned int *) addr) + (nr >> 5);
__asm__ __volatile__(
"1: ldl_l %0,%1\n"
" and %0,%3,%2\n"
" bne %2,2f\n"
" xor %0,%3,%0\n"
" stl_c %0,%1\n"
" beq %0,3f\n"
" mb\n"
"2:\n"
".subsection 2\n"
"3: br 1b\n"
".previous"
:"=&r" (temp), "=m" (*m), "=&r" (oldbit)
:"Ir" (1UL << (nr & 31)), "m" (*m));
return oldbit != 0;
}
static __inline__ void _spin_lock(volatile void *lock)
{
long tmp;
/* Use sub-sections to put the actual loop at the end
of this object file's text section so as to perfect
branch prediction. */
__asm__ __volatile__(
"1: ldl_l %0,%1\n"
" blbs %0,2f\n"
" or %0,1,%0\n"
" stl_c %0,%1\n"
" beq %0,2f\n"
" mb\n"
".subsection 2\n"
"2: ldl %0,%1\n"
" blbs %0,2b\n"
" br 1b\n"
".previous"
: "=r" (tmp), "=m" (__dummy_lock(lock))
: "m"(__dummy_lock(lock)));
}
static inline void _write_lock(rwlock_t * lock)
{
long regx;
__asm__ __volatile__(
"1: ldl_l %1,%0\n"
" bne %1,6f\n"
" or $31,1,%1\n"
" stl_c %1,%0\n"
" beq %1,6f\n"
" mb\n"
".subsection 2\n"
"6: ldl %1,%0\n"
" bne %1,6b\n"
" br 1b\n"
".previous"
: "=m" (__dummy_lock(lock)), "=&r" (regx)
: "0" (__dummy_lock(lock))
);
}
static inline void _read_lock(rwlock_t * lock)
{
long regx;
__asm__ __volatile__(
"1: ldl_l %1,%0\n"
" blbs %1,6f\n"
" subl %1,2,%1\n"
" stl_c %1,%0\n"
" beq %1,6f\n"
"4: mb\n"
".subsection 2\n"
"6: ldl %1,%0\n"
" blbs %1,6b\n"
" br 1b\n"
".previous"
: "=m" (__dummy_lock(lock)), "=&r" (regx)
: "m" (__dummy_lock(lock))
);
}
static inline void _write_unlock(rwlock_t * lock)
{
mb();
*(volatile int *)lock = 0;
}
static inline void _read_unlock(rwlock_t * lock)
{
long regx;
__asm__ __volatile__(
"1: ldl_l %1,%0\n"
" addl %1,2,%1\n"
" stl_c %1,%0\n"
" beq %1,6f\n"
".subsection 2\n"
"6: br 1b\n"
".previous"
: "=m" (__dummy_lock(lock)), "=&r" (regx)
: "m" (__dummy_lock(lock)));
}

58
OPTYap/mips_locks.h Normal file
View File

@@ -0,0 +1,58 @@
/* ------------------------------- **
** Atomic locking for MIPS **
** ------------------------------- */
/* This code is stolen from the Linux kernel */
typedef struct { unsigned long a[100]; } __dummy_lock_t;
#define __dummy_lock(lock) (*(__dummy_lock_t *)(lock))
#define load_linked(addr) \
({ \
unsigned int __res; \
\
__asm__ __volatile__( \
"ll\t%0,(%1)" \
: "=r" (__res) \
: "r" ((unsigned long) (addr))); \
\
__res; \
})
#define store_conditional(addr,value) \
({ \
int __res; \
\
__asm__ __volatile__( \
"sc\t%0,(%2)" \
: "=r" (__res) \
: "0" (value), "r" (addr)); \
\
__res; \
})
#define INIT_LOCK(LOCK_VAR) ((LOCK_VAR) = 0)
#define TRY_LOCK(LOCK_PTR) (!test_and_set_bit(0,(__dumy_lock_t *)(LOCK_PTR)))
#define LOCK(LOCK_VAR) _spin_lock((__dummy_lock_t *)(&(LOCK_VAR)))
#define IS_LOCKED(LOCK_VAR) ((LOCK_VAR) != 0)
#define IS_UNLOCKED(LOCK_VAR) ((LOCK_VAR) == 0)
/* We need to support sync on MIPS */
#define UNLOCK(LOCK_VAR) spin_unlock((__dummy_lock_t *)(&(LOCK_VAR)))
typedef struct {
volatile unsigned int lock;
} rwlock_t;
#define RW_LOCK_UNLOCKED (rwlock_t) { 0 }
#define READ_LOCK(X) _read_lock(&(X))
#define READ_UNLOCK(X) _read_unlock(&(X))
#define WRITE_LOCK(X) _write_lock(&(X))
#define WRITE_UNLOCK(X) _write_unlock(&(X))
#define INIT_RWLOCK(RW) (RW) = RW_LOCK_UNLOCKED

115
OPTYap/mips_locks_funcs.h Normal file
View File

@@ -0,0 +1,115 @@
/* ------------------------------- **
** Atomic locking for MIPS **
** ------------------------------- */
static __inline__ int test_and_set_bit(int nr, volatile void *addr)
{
int mask, retval, mw;
mask = 1;
do {
mw = load_linked(addr);
retval = (mask & mw) != 0;
} while (!store_conditional(addr, mw|mask));
return retval;
}
static inline void _spin_lock(__dummy_lock_t *lock)
{
unsigned int tmp;
__asm__ __volatile__(
".set\tnoreorder\t\t\t# spin_lock\n"
"1:\tll\t%1, %2\n\t"
"bnez\t%1, 1b\n\t"
" li\t%1, 1\n\t"
"sc\t%1, %0\n\t"
"beqz\t%1, 1b\n\t"
" sync\n\t"
".set\treorder"
: "=o" (__dummy_lock(lock)), "=&r" (tmp)
: "o" (__dummy_lock(lock))
: "memory");
}
static inline void spin_unlock(__dummy_lock_t *lock)
{
__asm__ __volatile__(
".set\tnoreorder\t\t\t# spin_unlock\n\t"
"sync\n\t"
"sw\t$0, %0\n\t"
".set\treorder"
: "=o" (__dummy_lock(lock))
: "o" (__dummy_lock(lock))
: "memory");
}
static inline void _read_lock(rwlock_t *rw)
{
unsigned int tmp;
__asm__ __volatile__(
".set\tnoreorder\t\t\t# read_lock\n"
"1:\tll\t%1, %2\n\t"
"bltz\t%1, 1b\n\t"
" addu\t%1, 1\n\t"
"sc\t%1, %0\n\t"
"beqz\t%1, 1b\n\t"
" sync\n\t"
".set\treorder"
: "=o" (__dummy_lock(rw)), "=&r" (tmp)
: "o" (__dummy_lock(rw))
: "memory");
}
/* Note the use of sub, not subu which will make the kernel die with an
overflow exception if we ever try to unlock an rwlock that is already
unlocked or is being held by a writer. */
static inline void _read_unlock(rwlock_t *rw)
{
unsigned int tmp;
__asm__ __volatile__(
".set\tnoreorder\t\t\t# read_unlock\n"
"1:\tll\t%1, %2\n\t"
"sub\t%1, 1\n\t"
"sc\t%1, %0\n\t"
"beqz\t%1, 1b\n\t"
".set\treorder"
: "=o" (__dummy_lock(rw)), "=&r" (tmp)
: "o" (__dummy_lock(rw))
: "memory");
}
static inline void _write_lock(rwlock_t *rw)
{
unsigned int tmp;
__asm__ __volatile__(
".set\tnoreorder\t\t\t# write_lock\n"
"1:\tll\t%1, %2\n\t"
"bnez\t%1, 1b\n\t"
" lui\t%1, 0x8000\n\t"
"sc\t%1, %0\n\t"
"beqz\t%1, 1b\n\t"
" sync\n\t"
".set\treorder"
: "=o" (__dummy_lock(rw)), "=&r" (tmp)
: "o" (__dummy_lock(rw))
: "memory");
}
static inline void _write_unlock(rwlock_t *rw)
{
__asm__ __volatile__(
".set\tnoreorder\t\t\t# write_unlock\n\t"
"sync\n\t"
"sw\t$0, %0\n\t"
".set\treorder"
: "=o" (__dummy_lock(rw))
: "o" (__dummy_lock(rw))
: "memory");
}

131
OPTYap/opt.config.h Normal file
View File

@@ -0,0 +1,131 @@
/* ---------------------------------- **
** Configuration Parameters **
** ---------------------------------- */
#define MAX_LENGTH_ANSWER 500
#define MAX_DEPTH 1000
#define MAX_BEST_TIMES 21
#define MAX_TABLE_VARS 1000
#define TABLE_LOCK_BUCKETS 512
#define TG_ANSWER_SLOTS 20
#define STATISTICS
/*
#define YAPOR_ERRORS
#define TABLING_ERRORS
*/
/* x86_locks.h */
#define UNIQUE_WHILE_LOCK
/* amiops.h */
#define BFZ_TRAIL_SCHEME 1
/*#define BBREG_TRAIL_SCHEME*/
#define TABLING_INNER_CUTS
#define TIMESTAMP_CHECK
/*#define TABLE_LOCK_AT_ENTRY_LEVEL*/
/*#define TABLE_LOCK_AT_NODE_LEVEL*/
#define TABLE_LOCK_AT_WRITE_LEVEL
/* tab.tries.c */
/*#define ALLOC_BEFORE_CHECK*/
/* use heap instead of special areas for memory allocation */
#define USE_HEAP 1
/* -------------------------- **
** Parameter Checks **
** -------------------------- */
#ifndef YAPOR
#undef YAPOR_ERRORS
#endif
#ifndef TABLING
#undef TABLING_ERRORS
#endif
#if defined(YAPOR_ERRORS) && defined(TABLING_ERRORS)
#define OPTYAP_ERRORS
#endif
#ifndef YAPOR
#undef UNIQUE_WHILE_LOCK
#endif
#ifdef TABLING
#if !defined(BFZ_TRAIL_SCHEME) && !defined(BBREG_TRAIL_SCHEME)
#error Define a trail scheme
#endif
#if defined(BFZ_TRAIL_SCHEME) && defined(BBREG_TRAIL_SCHEME)
#error Do not define multiple trail schemes
#endif
#else
#undef BFZ_TRAIL_SCHEME
#undef BBREG_TRAIL_SCHEME
#endif
#if !defined(TABLING) || !defined(YAPOR)
#undef TABLING_INNER_CUTS
#endif
#if !defined(YAPOR) || !defined(TABLING)
#undef TIMESTAMP_CHECK
#endif
/* ------------------------------------------------------------------ **
** **
** There are three lock schemes to access the table space. **
** **
** 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 through the table data structures. **
** **
** The TABLE_LOCK_AT_NODE_LEVEL scheme locks each data structure **
** before accessing it. It decreases concurrrency for workers **
** accessing commom parts of the table space. **
** **
** The TABLE_LOCK_AT_WRITE_LEVEL scheme is an hibrid scheme, it only **
** locks a table data structure when it is going to update it. **
** **
** The TABLE_LOCK_AT_WRITE_LEVEL is the default scheme. **
** **
** ------------------------------------------------------------------ */
#if defined(YAPOR) && defined(TABLING)
#if !defined(TABLE_LOCK_AT_ENTRY_LEVEL) && !defined(TABLE_LOCK_AT_NODE_LEVEL) && !defined(TABLE_LOCK_AT_WRITE_LEVEL)
#error Define a table lock scheme
#endif
#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
#if defined(TABLE_LOCK_AT_NODE_LEVEL) || defined(TABLE_LOCK_AT_WRITE_LEVEL)
#error Do not define multiple table lock schemes
#endif
#endif
#if defined(TABLE_LOCK_AT_NODE_LEVEL) && defined(TABLE_LOCK_AT_WRITE_LEVEL)
#error Do not define multiple table lock schemes
#endif
#else
#undef TABLE_LOCK_AT_ENTRY_LEVEL
#undef TABLE_LOCK_AT_NODE_LEVEL
#undef TABLE_LOCK_AT_WRITE_LEVEL
#endif /* YAPOR && TABLING */
#ifndef TABLE_LOCK_AT_WRITE_LEVEL
#undef ALLOC_BEFORE_CHECK
#endif

293
OPTYap/opt.init.c Normal file
View File

@@ -0,0 +1,293 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#define OPT_MAVAR_STATIC
#if defined(YAPOR) || defined(TABLING)
#include "Yatom.h"
#include "Heap.h"
#include <unistd.h>
#include <signal.h>
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
#if defined(TABLING) || !defined(ACOW)
#ifndef TABLING
#include "opt.mavar.h"
#endif
#ifdef MULTI_ASSIGNMENT_VARIABLES
ma_hash_entry ma_hash_table[MAVARS_HASH_SIZE];
UInt timestamp; /* an unsigned int */
ma_h_inner_struct *ma_h_top;
#endif /* MULTI_ASSIGNMENT_VARIABLES */
#endif
#ifdef ACOW
#include "sys/wait.h"
#endif /* ACOW */
/* ------------------------------------- **
** Local functions declaration **
** ------------------------------------- */
static void receive_signals(int s);
/* ---------------------- **
** Local macros **
** ---------------------- */
#define STRUCTS_PER_PAGE(STR_TYPE) ((PageSize - STRUCT_SIZE(struct page_header)) / STRUCT_SIZE(STR_TYPE))
#ifdef STATISTICS
#define INIT_PAGE_STATISTICS(PG) \
Pg_pg_alloc(PG) = 0; \
Pg_str_alloc(PG) = 0; \
Pg_str_in_use(PG) = 0; \
Pg_requests(PG) = 0
#else
#define INIT_PAGE_STATISTICS(PG)
#endif /* STATISTICS */
#define INIT_PAGES(PG, STR_TYPE) \
INIT_LOCK(Pg_lock(PG)); \
Pg_str_per_pg(PG) = STRUCTS_PER_PAGE(STR_TYPE); \
Pg_free_pg(PG) = NULL; \
INIT_PAGE_STATISTICS(PG)
/* -------------------------- **
** Global functions **
** -------------------------- */
void init_global(int n_workers, int sch_loop, int delay_load) {
int i;
/* global data related to memory management */
INIT_PAGES(GLOBAL_PAGES_void, void *);
#ifdef YAPOR
INIT_PAGES(GLOBAL_PAGES_or_fr, struct or_frame);
INIT_PAGES(GLOBAL_PAGES_qg_sol_fr, struct query_goal_solution_frame);
INIT_PAGES(GLOBAL_PAGES_qg_ans_fr, struct query_goal_answer_frame);
#endif /* YAPOR */
#ifdef TABLING_INNER_CUTS
INIT_PAGES(GLOBAL_PAGES_tg_sol_fr, struct table_subgoal_solution_frame);
INIT_PAGES(GLOBAL_PAGES_tg_ans_fr, struct table_subgoal_answer_frame);
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
INIT_PAGES(GLOBAL_PAGES_tab_ent, struct table_entry);
INIT_PAGES(GLOBAL_PAGES_sg_fr, struct subgoal_frame);
INIT_PAGES(GLOBAL_PAGES_sg_node, struct subgoal_trie_node);
INIT_PAGES(GLOBAL_PAGES_ans_node, struct answer_trie_node);
INIT_PAGES(GLOBAL_PAGES_sg_hash, struct subgoal_hash);
INIT_PAGES(GLOBAL_PAGES_ans_hash, struct answer_hash);
INIT_PAGES(GLOBAL_PAGES_dep_fr, struct dependency_frame);
#endif /* TABLING */
#if defined(YAPOR) && defined(TABLING)
INIT_PAGES(GLOBAL_PAGES_susp_fr, struct suspension_frame);
#endif /* YAPOR && TABLING */
#ifdef YAPOR
/* global static data */
number_workers = n_workers;
worker_pid(0) = getpid();
for (i = 1; i < number_workers; i++) worker_pid(i) = 0;
SCHEDULER_LOOP = sch_loop;
DELAYED_RELEASE_LOAD = delay_load;
/* global data related to or-performance */
GLOBAL_number_goals = 0;
GLOBAL_best_times(0) = 0;
GLOBAL_performance_mode = PERFORMANCE_OFF;
/* global data related to or-parallelism */
BITMAP_clear(GLOBAL_bm_present_workers);
for (i = 0; i < number_workers; i++)
BITMAP_insert(GLOBAL_bm_present_workers, i);
BITMAP_copy(GLOBAL_bm_idle_workers, GLOBAL_bm_present_workers);
BITMAP_clear(GLOBAL_bm_root_cp_workers);
BITMAP_clear(GLOBAL_bm_invisible_workers);
BITMAP_clear(GLOBAL_bm_requestable_workers);
BITMAP_clear(GLOBAL_bm_executing_workers);
BITMAP_copy(GLOBAL_bm_finished_workers, GLOBAL_bm_present_workers);
INIT_LOCK(GLOBAL_LOCKS_bm_idle_workers);
INIT_LOCK(GLOBAL_LOCKS_bm_root_cp_workers);
INIT_LOCK(GLOBAL_LOCKS_bm_invisible_workers);
INIT_LOCK(GLOBAL_LOCKS_bm_requestable_workers);
INIT_LOCK(GLOBAL_LOCKS_bm_executing_workers);
INIT_LOCK(GLOBAL_LOCKS_bm_finished_workers);
#ifdef TABLING_INNER_CUTS
INIT_LOCK(GLOBAL_LOCKS_bm_pruning_workers);
#endif /* TABLING_INNER_CUTS */
GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS;
INIT_LOCK(GLOBAL_LOCKS_heap_access);
INIT_LOCK(GLOBAL_LOCKS_alloc_block);
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
INIT_LOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
if (number_workers == 1)
PARALLEL_EXECUTION_MODE = FALSE;
else
PARALLEL_EXECUTION_MODE = TRUE;
#endif /* YAPOR */
#ifdef TABLING
/* global data related to tabling */
for (i = 0; i < MAX_TABLE_VARS; i++)
GLOBAL_table_var_enumerator(i) = (CELL) & GLOBAL_table_var_enumerator(i);
#ifdef TABLE_LOCK_AT_WRITE_LEVEL
for (i = 0; i < TABLE_LOCK_BUCKETS; i++)
INIT_LOCK(GLOBAL_table_lock(i));
#endif /* TABLE_LOCK_AT_WRITE_LEVEL */
#endif /* TABLING */
return;
}
void init_local(void) {
#ifdef YAPOR
/* local data related to or-parallelism */
LOCAL = REMOTE+worker_id;
LOCAL_top_cp = B_BASE;
LOCAL_top_or_fr = GLOBAL_root_or_fr;
LOCAL_load = 0;
LOCAL_share_request = MAX_WORKERS;
LOCAL_reply_signal = ready;
#ifdef ENV_COPY
INIT_LOCK(LOCAL_lock_signals);
#endif /* ENV_COPY */
LOCAL_prune_request = NULL;
#endif /* YAPOR */
INIT_LOCK(LOCAL_lock);
#ifdef TABLING
/* local data related to tabling */
LOCAL_next_free_ans_node = NULL;
LOCAL_top_sg_fr = NULL;
LOCAL_top_dep_fr = GLOBAL_root_dep_fr;
#ifdef YAPOR
LOCAL_top_cp_on_stack = B_BASE; /* ??? */
LOCAL_top_susp_or_fr = GLOBAL_root_or_fr;
#endif /* YAPOR */
#endif /* TABLING */
return;
}
void make_root_frames(void) {
#ifdef YAPOR
/* root or frame */
or_fr_ptr or_fr;
ALLOC_OR_FRAME(or_fr);
INIT_LOCK(OrFr_lock(or_fr));
OrFr_alternative(or_fr) = NULL;
BITMAP_copy(OrFr_members(or_fr), GLOBAL_bm_present_workers);
OrFr_node(or_fr) = B_BASE;
OrFr_nearest_livenode(or_fr) = NULL;
OrFr_depth(or_fr) = 0;
OrFr_pend_prune_cp(or_fr) = NULL;
OrFr_nearest_leftnode(or_fr) = or_fr;
OrFr_qg_solutions(or_fr) = NULL;
#ifdef TABLING_INNER_CUTS
OrFr_tg_solutions(or_fr) = NULL;
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
OrFr_owners(or_fr) = number_workers;
OrFr_next_on_stack(or_fr) = NULL;
OrFr_suspensions(or_fr) = NULL;
OrFr_nearest_suspnode(or_fr) = or_fr;
#endif /* TABLING */
OrFr_next(or_fr) = NULL;
GLOBAL_root_or_fr = or_fr;
#endif /* YAPOR */
#ifdef TABLING
/* root dependency frame */
new_dependency_frame(GLOBAL_root_dep_fr, FALSE, NULL, NULL, NULL, NULL, NULL);
#endif /* TABLING */
}
#ifdef YAPOR
void init_workers(void) {
int proc;
#ifdef ACOW
if (number_workers > 1) {
int son;
son = fork();
if (son == -1) abort_optyap("fork error in function init_workers");
if (son > 0) {
/* I am the father, I must stay here and wait for my children to all die */
struct sigaction sigact;
GLOBAL_master_worker = getpid();
sigact.sa_handler = SIG_DFL;
sigemptyset(&sigact.sa_mask);
sigact.sa_flags = SA_RESTART;
sigaction(SIGINT, &sigact, NULL);
pause();
exit(0);
} else worker_pid(0) = getpid();
}
#endif /* ACOW */
for (proc = 1; proc < number_workers; proc++) {
int son;
son = fork();
if (son == -1) abort_optyap("fork error in function init_workers");
if (son == 0) {
/* new worker */
worker_id = proc;
remap_memory();
break;
}
else worker_pid(proc) = son;
}
}
#endif /* YAPOR */
void init_signals(void) {
return;
signal(SIGQUIT, receive_signals);
signal(SIGTERM, receive_signals);
signal(SIGSEGV, receive_signals);
signal(SIGABRT, receive_signals);
signal(SIGFPE, receive_signals);
signal(SIGHUP, receive_signals);
signal(SIGINT, receive_signals);
signal(SIGTSTP, receive_signals);
return;
}
/* ------------------------- **
** Local functions **
** ------------------------- */
static
void receive_signals(int s) {
abort_optyap("receiving signal number %d", s);
return;
}
#endif /* YAPOR || TABLING */

335
OPTYap/opt.macros.h Normal file
View File

@@ -0,0 +1,335 @@
/* --------------------------- **
** Memory management **
** --------------------------- */
extern int PageSize;
#define H_BASE ((CELL *) GlobalBase)
#define B_BASE ((choiceptr) LocalBase)
#define TR_BASE ((tr_fr_ptr) TrailBase)
#if SIZEOF_INT_P == 4
#define ALIGN 3
#define ALIGNMASK 0xfffffffc
#elif SIZEOF_INT_P == 8
#define ALIGN 7
#define ALIGNMASK 0xfffffff8
#else
#define ALIGN OOOOPPS!!! Unknown Pointer Sizeof
#define ALIGNMASK OOOOPPS!!! Unknown Pointer Sizeof
#endif /* SIZEOF_INT_P */
#define ADJUST_SIZE(SIZE) ((SIZE + ALIGN) & ALIGNMASK)
#define ADJUST_SIZE_TO_PAGE(SIZE) ((SIZE) - (SIZE) % PageSize + PageSize)
#define STRUCT_SIZE(STR_TYPE) ADJUST_SIZE(sizeof(STR_TYPE))
#define PAGE_HEADER(STR) (pg_hd_ptr)((unsigned int)STR - (unsigned int)STR % PageSize)
#define STRUCT_NEXT(STR) ((STR)->next)
#ifdef STATISTICS
#define UPDATE_STATS(STAT, VALUE) STAT += VALUE
#else
#define UPDATE_STATS(STAT, VALUE)
#endif /* STATISTICS */
#define ALLOC_BLOCK(BLOCK, SIZE) \
BLOCK = (void *) AllocAtomSpace(SIZE)
#define FREE_BLOCK(BLOCK) \
FreeCodeSpace((char *) (BLOCK))
#define ALLOC_HASH_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **ptr; \
ALLOC_BLOCK(ptr, NUM_BUCKETS * sizeof(void *)); \
BUCKET_PTR = (void *) ptr; \
for (i = NUM_BUCKETS; i != 0; i--) \
*ptr++ = NULL; \
}
#define FREE_HASH_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR)
#ifdef USE_HEAP
#define alloc_memory_block(SIZE) (void *)AllocCodeSpace(SIZE)
#define free_memory_block(BLK) FreeCodeSpace((ADDR)BLK)
#define reset_alloc_block_area()
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) STR = (STR_TYPE *)AllocCodeSpace(sizeof(STR_TYPE))
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) STR = (STR_TYPE *)AllocCodeSpace(sizeof(STR_TYPE))
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) FreeCodeSpace((ADDR)(STR))
#else
#define ALLOC_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), 1); \
if (Pg_free_pg(GLOBAL_PAGES_void) == NULL) { \
if (TopAllocArea == TopWorkArea) \
abort_optyap("no more free alloc space (ALLOC_PAGE)"); \
UPDATE_STATS(Pg_str_alloc(GLOBAL_PAGES_void), 1); \
PG_HD = (pg_hd_ptr)TopAllocArea; \
TopAllocArea += PageSize; \
} else { \
PG_HD = Pg_free_pg(GLOBAL_PAGES_void); \
Pg_free_pg(GLOBAL_PAGES_void) = PgHd_next(PG_HD); \
} \
UNLOCK(Pg_lock(GLOBAL_PAGES_void))
#define FREE_PAGE(PG_HD) \
LOCK(Pg_lock(GLOBAL_PAGES_void)); \
UPDATE_STATS(Pg_requests(GLOBAL_PAGES_void), 1); \
UPDATE_STATS(Pg_str_in_use(GLOBAL_PAGES_void), -1); \
PgHd_next(PG_HD) = Pg_free_pg(GLOBAL_PAGES_void); \
Pg_free_pg(GLOBAL_PAGES_void) = PG_HD; \
UNLOCK(Pg_lock(GLOBAL_PAGES_void))
#define ALLOC_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ pg_hd_ptr pg_hd; \
LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_requests(STR_PAGES), 1); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
if (Pg_free_pg(STR_PAGES)) { \
pg_hd = Pg_free_pg(STR_PAGES); \
PgHd_str_in_use(pg_hd)++; \
STR = (STR_TYPE *) PgHd_free_str(pg_hd); \
if ((PgHd_free_str(pg_hd) = (void *) STRUCT_NEXT(STR)) == NULL) \
Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd); \
UNLOCK(Pg_lock(STR_PAGES)); \
} else { \
int i; \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), 1); \
UPDATE_STATS(Pg_str_alloc(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \
UNLOCK(Pg_lock(STR_PAGES)); \
ALLOC_PAGE(pg_hd); \
PgHd_str_in_use(pg_hd) = 1; \
PgHd_previous(pg_hd) = NULL; \
STR = (STR_TYPE *) (pg_hd + 1); \
PgHd_free_str(pg_hd) = (void *) ++STR; \
for (i = Pg_str_per_pg(STR_PAGES); i != 2; i--) { \
STRUCT_NEXT(STR) = STR + 1; \
STR++; \
} \
STRUCT_NEXT(STR) = NULL; \
STR = (STR_TYPE *) (pg_hd + 1); \
LOCK(Pg_lock(STR_PAGES)); \
if ((PgHd_next(pg_hd) = Pg_free_pg(STR_PAGES)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = pg_hd; \
Pg_free_pg(STR_PAGES) = pg_hd; \
UNLOCK(Pg_lock(STR_PAGES)); \
} \
}
#define ALLOC_NEXT_FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
if ((STR = LOCAL_next_free_ans_node) == NULL) { \
pg_hd_ptr pg_hd; \
LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_requests(STR_PAGES), 1); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \
if (Pg_free_pg(STR_PAGES)) { \
pg_hd = Pg_free_pg(STR_PAGES); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -PgHd_str_in_use(pg_hd)); \
PgHd_str_in_use(pg_hd) = Pg_str_per_pg(STR_PAGES); \
STR = (STR_TYPE *) PgHd_free_str(pg_hd); \
PgHd_free_str(pg_hd) = NULL; \
Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd); \
UNLOCK(Pg_lock(STR_PAGES)); \
} else { \
int i; \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), 1); \
UPDATE_STATS(Pg_str_alloc(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \
UNLOCK(Pg_lock(STR_PAGES)); \
ALLOC_PAGE(pg_hd); \
PgHd_str_in_use(pg_hd) = Pg_str_per_pg(STR_PAGES); \
PgHd_free_str(pg_hd) = NULL; \
PgHd_previous(pg_hd) = NULL; \
PgHd_next(pg_hd) = NULL; \
STR = (STR_TYPE *) (pg_hd + 1); \
for (i = Pg_str_per_pg(STR_PAGES); i != 1; i--) { \
STRUCT_NEXT(STR) = STR + 1; \
STR++; \
} \
STRUCT_NEXT(STR) = NULL; \
STR = (STR_TYPE *) (pg_hd + 1); \
} \
} \
LOCAL_next_free_ans_node = STRUCT_NEXT(STR)
#define FREE_STRUCT(STR, STR_PAGES, STR_TYPE) \
{ pg_hd_ptr pg_hd; \
pg_hd = PAGE_HEADER(STR); \
LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_requests(STR_PAGES), 1); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
if (--PgHd_str_in_use(pg_hd) == 0) { \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), -1); \
UPDATE_STATS(Pg_str_alloc(STR_PAGES), -Pg_str_per_pg(STR_PAGES)); \
if (PgHd_previous(pg_hd)) { \
if ((PgHd_next(PgHd_previous(pg_hd)) = PgHd_next(pg_hd)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = PgHd_previous(pg_hd); \
} else { \
if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
} \
UNLOCK(Pg_lock(STR_PAGES)); \
FREE_PAGE(pg_hd); \
} else { \
if ((STRUCT_NEXT(STR) = (STR_TYPE *) PgHd_free_str(pg_hd)) == NULL) { \
PgHd_previous(pg_hd) = NULL; \
if ((PgHd_next(pg_hd) = Pg_free_pg(STR_PAGES)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = pg_hd; \
Pg_free_pg(STR_PAGES) = pg_hd; \
} \
PgHd_free_str(pg_hd) = (void *) STR; \
UNLOCK(Pg_lock(STR_PAGES)); \
} \
}
#endif /* TEST*/
#define ALLOC_OR_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_or_fr, struct or_frame)
#define FREE_OR_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_or_fr, struct or_frame)
#define ALLOC_QG_SOLUTION_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_qg_sol_fr, struct query_goal_solution_frame)
#define FREE_QG_SOLUTION_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_qg_sol_fr, struct query_goal_solution_frame)
#define ALLOC_QG_ANSWER_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_qg_ans_fr, struct query_goal_answer_frame)
#define FREE_QG_ANSWER_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_qg_ans_fr, struct query_goal_answer_frame)
#define ALLOC_TG_SOLUTION_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_tg_sol_fr, struct table_subgoal_solution_frame)
#define FREE_TG_SOLUTION_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_tg_sol_fr, struct table_subgoal_solution_frame)
#define ALLOC_TG_ANSWER_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_tg_ans_fr, struct table_subgoal_answer_frame)
#define FREE_TG_ANSWER_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_tg_ans_fr, struct table_subgoal_answer_frame)
#define ALLOC_TABLE_ENTRY(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_tab_ent, struct table_entry)
#define FREE_TABLE_ENTRY(STR) FREE_STRUCT(STR, GLOBAL_PAGES_tab_ent, struct table_entry)
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_node, struct subgoal_trie_node)
#define ALLOC_SUBGOAL_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_fr, struct subgoal_frame)
#define FREE_SUBGOAL_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_fr, struct subgoal_frame)
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_NEXT_FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, GLOBAL_PAGES_ans_node, struct answer_trie_node)
#define ALLOC_DEPENDENCY_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_dep_fr, struct dependency_frame)
#define FREE_DEPENDENCY_FRAME(STR) FREE_STRUCT(STR, GLOBAL_PAGES_dep_fr, struct dependency_frame)
#define ALLOC_SUSPENSION_FRAME(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_susp_fr, struct suspension_frame)
#define FREE_SUSPENSION_FRAME(STR) FREE_BLOCK(SuspFr_global_start(STR)); \
FREE_STRUCT(STR, GLOBAL_PAGES_susp_fr, struct suspension_frame)
#define ALLOC_SUBGOAL_HASH(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_sg_hash, struct subgoal_hash)
#define FREE_SUBGOAL_HASH(STR) FREE_STRUCT(STR, GLOBAL_PAGES_sg_hash, struct subgoal_hash)
#define ALLOC_ANSWER_HASH(STR) ALLOC_STRUCT(STR, GLOBAL_PAGES_ans_hash, struct answer_hash)
#define FREE_ANSWER_HASH(STR) FREE_STRUCT(STR, GLOBAL_PAGES_ans_hash, struct answer_hash)
/* ------------------------------------- **
** Bitmap tests and operations **
** ------------------------------------- */
#define BITMAP_empty(b) ((b) == 0)
#define BITMAP_member(b,n) (((b) & (1<<(n))) != 0)
#define BITMAP_alone(b,n) ((b) == (1<<(n)))
#define BITMAP_subset(b1,b2) (((b1) & (b2)) == b2)
#define BITMAP_same(b1,b2) ((b1) == (b2))
#define BITMAP_clear(b) ((b) = 0)
#define BITMAP_and(b1,b2) ((b1) &= (b2))
#define BITMAP_minus(b1,b2) ((b1) &= ~(b2))
#define BITMAP_insert(b,n) ((b) |= (1<<(n)))
#define BITMAP_delete(b,n) ((b) &= (~(1<<(n))))
#define BITMAP_copy(b1,b2) ((b1) = (b2))
#define BITMAP_intersection(b1,b2,b3) ((b1) = ((b2) & (b3)))
#define BITMAP_difference(b1,b2,b3) ((b1) = ((b2) & (~(b3))))
/* ---------------------------------- **
** Message and debug macros **
** ---------------------------------- */
#define INFORMATION_MESSAGE(MESG, ARGS...) information_message(MESG, ##ARGS)
#ifdef YAPOR_ERRORS
#define YAPOR_ERROR_MESSAGE(MESG, ARGS...) error_message(MESG, ##ARGS)
#else
#define YAPOR_ERROR_MESSAGE(MESG, ARGS...)
#endif /* YAPOR_ERRORS */
#ifdef TABLING_ERRORS
#define TABLING_ERROR_MESSAGE(MESG, ARGS...) error_message(MESG, ##ARGS)
#else
#define TABLING_ERROR_MESSAGE(MESG, ARGS...)
#endif /* TABLING_ERRORS */
#ifdef OPTYAP_ERRORS
#define OPTYAP_ERROR_MESSAGE(MESG, ARGS...) error_message(MESG, ##ARGS)
#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 */

94
OPTYap/opt.mavar.h Normal file
View File

@@ -0,0 +1,94 @@
#ifdef MULTI_ASSIGNMENT_VARIABLES
/*
Set of routines to allow restoring updatable variables when we go *up*
in the tree. Required by copying, SBA, and tabling. Not required by ACOW.
*/
#ifndef OPT_MAVAR_STATIC
#define OPT_MAVAR_STATIC inline static
#endif
#define MAVARS_HASH_SIZE 512
typedef struct ma_h_entry {
CELL* addr;
struct ma_h_entry *next;
} ma_h_inner_struct;
typedef struct {
UInt timestmp;
struct ma_h_entry val;
} ma_hash_entry;
extern ma_hash_entry ma_hash_table[MAVARS_HASH_SIZE];
extern UInt timestamp; /* an unsigned int */
OPT_MAVAR_STATIC unsigned int MAVAR_HASH(CELL *);
OPT_MAVAR_STATIC struct ma_h_entry *ALLOC_NEW_MASPACE(void);
OPT_MAVAR_STATIC int lookup_ma_var(CELL *);
OPT_MAVAR_STATIC UInt NEW_MAHASH(ma_h_inner_struct *);
OPT_MAVAR_STATIC unsigned int
MAVAR_HASH(CELL *addr) {
#if SIZEOF_INT_P==8
return((((unsigned int)((CELL)(addr)))>>3)%MAVARS_HASH_SIZE);
#else
return((((unsigned int)((CELL)(addr)))>>2)%MAVARS_HASH_SIZE);
#endif
}
extern ma_h_inner_struct *ma_h_top;
OPT_MAVAR_STATIC struct ma_h_entry *
ALLOC_NEW_MASPACE(void)
{
ma_h_inner_struct *new = ma_h_top;
ma_h_top++;
return(new);
}
OPT_MAVAR_STATIC int
lookup_ma_var(CELL *addr) {
unsigned int i = MAVAR_HASH(addr);
struct ma_h_entry *nptr, *optr;
if (ma_hash_table[i].timestmp != timestamp) {
ma_hash_table[i].timestmp = timestamp;
ma_hash_table[i].val.addr = addr;
ma_hash_table[i].val.next = NULL;
return(FALSE);
}
if (ma_hash_table[i].val.addr == addr)
return(TRUE);
optr = &(ma_hash_table[i].val);
nptr = ma_hash_table[i].val.next;
while (nptr != NULL) {
if (nptr->addr == addr) {
return(TRUE);
}
optr = nptr;
nptr = nptr->next;
}
nptr = ALLOC_NEW_MASPACE();
nptr->addr = addr;
nptr->next = optr;
return(FALSE);
}
OPT_MAVAR_STATIC UInt
NEW_MAHASH(ma_h_inner_struct *top) {
UInt time = ++timestamp;
if (time == 0) {
unsigned int i;
/* damn, we overflowed */
for (i = 0; i < MAVARS_HASH_SIZE; i++)
ma_hash_table[i].timestmp = 0;
time = ++timestamp;
}
ma_h_top = top;
return(time);
}
#endif

377
OPTYap/opt.memory.c Normal file
View File

@@ -0,0 +1,377 @@
/* ------------------------------------------------------ **
** **
** By default we use mmap to map memory. **
** For i386 machines we use shared memory segments (shm). **
** **
** ------------------------------------------------------ */
#define MMAP_MEMORY_MAPPING_SCHEME
#ifdef i386
#undef MMAP_MEMORY_MAPPING_SCHEME
#define SHM_MEMORY_MAPPING_SCHEME
#endif /* i386 */
#if !defined(MMAP_MEMORY_MAPPING_SCHEME) && !defined(SHM_MEMORY_MAPPING_SCHEME)
#error Define a memory mapping scheme
#endif /* !MMAP_MEMORY_MAPPING_SCHEME && !SHM_MEMORY_MAPPING_SCHEME */
#if defined(MMAP_MEMORY_MAPPING_SCHEME) && defined(SHM_MEMORY_MAPPING_SCHEME)
#error Do not define multiple memory mapping schemes
#endif /* MMAP_MEMORY_MAPPING_SCHEME && SHM_MEMORY_MAPPING_SCHEME */
/* -------------------------------------- **
** Includes and local variables **
** -------------------------------------- */
#include "Yap.h"
#if defined(YAPOR) || defined(TABLING)
#include "Yatom.h"
#include "Heap.h"
#include "alloc.h"
#include "heapgc.h"
#include <signal.h>
#include <stdio.h>
#include <unistd.h>
#include <fcntl.h>
#include <errno.h>
#include <string.h>
#include <stdlib.h>
#include <sys/shm.h>
#include <sys/mman.h>
#define KBYTES 1024
#define HEAP_BLOCKS 1
#define OPT_BLOCKS 5
#define OPT_BLOCK_SIZE ADJUST_SIZE_TO_PAGE(10000 * KBYTES)
int PageSize;
#ifdef MMAP_MEMORY_MAPPING_SCHEME
int fd_mapfile;
#else /* SHM_MEMORY_MAPPING_SCHEME */
int shm_mapid[MAX_WORKERS + HEAP_BLOCKS + OPT_BLOCKS];
#endif /* MEMORY_MAPPING_SCHEME */
/* --------------------------- **
** Global functions **
** --------------------------- */
long global_data_size(void) {
return ADJUST_SIZE(sizeof(struct global_data));
}
long local_data_size(void) {
return ADJUST_SIZE(sizeof(struct local_data));
}
#ifdef SHM_MEMORY_MAPPING_SCHEME
void shm_map_memory(int id, int size, void *shmaddr) {
#define SHMMAX 0x2000000 /* as in <asm/shmparam.h> */
if (size > SHMMAX)
abort_optyap("maximum size for a shm segment exceeded in function shm_map_memory");
if ((shm_mapid[id] = shmget(IPC_PRIVATE, size, SHM_R|SHM_W)) == -1)
abort_optyap("shmget error in function shm_map_memory %s", strerror(errno));
if (shmat(shm_mapid[id], shmaddr, 0) == (void *) -1)
abort_optyap("shmat error in function shm_map_memory %s", strerror(errno));
return;
}
#else /* MMAP_MEMORY_MAPPING_SCHEME */
static void
open_mapfile(long TotalArea) {
char mapfile[20];
strcpy(mapfile,"/tmp/mapfile");
itos(getpid(), &mapfile[12]);
if ((fd_mapfile = open(mapfile, O_RDWR|O_CREAT|O_TRUNC, 0666)) < 0)
abort_optyap("open error in function open_mapfile %s", strerror(errno));
if (lseek(fd_mapfile, TotalArea, SEEK_SET) < 0)
abort_optyap("lseek error in function map_memory: %s", strerror(errno));
if (write(fd_mapfile, "", 1) < 0)
abort_optyap("write error in function map_memory: %s", strerror(errno));
return;
}
static void
close_mapfile(void) {
if (close(fd_mapfile) < 0)
abort_optyap("close error in function open_mapfile %s", strerror(errno));
}
#endif /* MMAP_MEMORY_MAPPING_SCHEME */
void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_workers) {
#ifndef ACOW
#ifdef YAPOR
int i;
#endif /* YAPOR */
long WorkerArea;
long TotalArea;
#else
#if MMAP_MEMORY_MAPPING_SCHEME
long TotalArea;
#endif
#endif
void *mmap_addr = (void *)MMAP_ADDR;
#ifdef ACOW
int private_fd_mapfile;
#endif /* ACOW */
/* Initial Allocation */
/* model indepndent */
PageSize = sysconf(_SC_PAGESIZE);
HeapArea = ADJUST_SIZE_TO_PAGE(HeapArea * KBYTES);
GlobalLocalArea = ADJUST_SIZE(GlobalLocalArea * KBYTES);
TrailAuxArea = ADJUST_SIZE(TrailAuxArea * KBYTES);
/* we'll need this later */
GlobalBase = mmap_addr + HeapArea;
/* model dependent */
/* shared memory allocation */
#ifdef ACOW
/* acow just needs one stack */
#ifdef MMAP_MEMORY_MAPPING_SCHEME
/* I need this for MMAP to know what it must allocate */
TotalArea = HeapArea;
#endif
#else
/* the others need n stacks */
WorkerArea = ADJUST_SIZE_TO_PAGE(GlobalLocalArea + TrailAuxArea);
TotalArea = HeapArea + WorkerArea * n_workers;
#endif /* ACOW */
/* step 2: mmap heap area */
#ifdef MMAP_MEMORY_MAPPING_SCHEME
/* map total area in a single go */
open_mapfile(TotalArea);
if ((mmap_addr = mmap((void *) MMAP_ADDR, (size_t) TotalArea, PROT_READ|PROT_WRITE,
MAP_SHARED|MAP_FIXED, fd_mapfile, 0)) == (void *) -1)
abort_optyap("mmap error in function map_memory: %s", strerror(errno));
#endif /* MEMORY_MAPPING_SCHEME */
/* Most systems are limited regarding what we can allocate */
#ifdef SHM_MEMORY_MAPPING_SCHEME
#ifdef ACOW
/* single shared segment in ACOW */
shm_map_memory(0, HeapArea, mmap_addr);
#else
/* place as segment n otherwise (0..n-1 reserved for stacks */
shm_map_memory(n_workers, HeapArea, mmap_addr);
#endif
#endif
#ifdef YAPOR
#ifdef ACOW
/* just allocate local space for stacks */
if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0)
abort_optyap("open error in function map_memory: %s", strerror(errno));
if (mmap(GlobalBase, GlobalLocalArea + TrailAuxArea, PROT_READ|PROT_WRITE,
MAP_PRIVATE|MAP_FIXED, private_fd_mapfile, 0) == (void *) -1)
abort_optyap("mmap error in function map_memory: %s", strerror(errno));
close(private_fd_mapfile);
#else /* ENV_COPY or SBA */
for (i = 0; i < n_workers; i++) {
/* initialize worker vars */
worker_area(i) = GlobalBase + i * WorkerArea;
worker_offset(i) = worker_area(i) - worker_area(0);
#ifdef SHM_MEMORY_MAPPING_SCHEME
/* mapping worker area */
shm_map_memory(i, WorkerArea, worker_area(i));
#endif /* SHM_MEMORY_MAPPING_SCHEME */
}
#endif /* ACOW */
#else /* TABLING */
#ifdef SHM_MEMORY_MAPPING_SCHEME
/* mapping worker area */
shm_map_memory(0, WorkerArea, mmap_addr + HeapArea);
#endif /* SHM_MEMORY_MAPPING_SCHEME */
#endif /* YAPOR */
#ifdef SBA
/* alloc space for the sparse binding array */
sba_size = WorkerArea * n_workers;
if ((binding_array = (char *)malloc(sba_size)) == NULL)
abort_optyap("malloc error in function map_memory: %s", strerror(errno));
if ((CELL)binding_array & MBIT) {
abort_optyap("OOPS: binding_array start address %p conflicts with tag %x used in IDB", binding_array, MBIT);
}
sba_offset = binding_array - GlobalBase;
sba_end = (int)binding_array + sba_size;
#endif /* SBA */
TrailBase = GlobalBase + GlobalLocalArea;
LocalBase = TrailBase - CellSize;
if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */
TrailTop = TrailBase + TrailAuxArea - 131072; /* 131072 = 262144 / 2 */
else
TrailTop = TrailBase + TrailAuxArea / 2;
AuxTop = TrailBase + TrailAuxArea - CellSize;
AuxSp = (CELL *) AuxTop;
YAP_InitHeap(mmap_addr);
BaseWorkArea = mmap_addr;
}
void unmap_memory (void) {
#ifdef SHM_MEMORY_MAPPING_SCHEME
int i;
#else /* MMAP_MEMORY_MAPPING_SCHEME */
char MapFile[20];
#endif /* MEMORY_MAPPING_SCHEME */
#ifdef YAPOR
{
int proc;
for (proc = 0; proc < number_workers; proc++) {
if (proc != worker_id && worker_pid(proc) != 0) {
if (kill(worker_pid(proc), SIGKILL) != 0)
INFORMATION_MESSAGE("Can't kill process %d", worker_pid(proc));
else
INFORMATION_MESSAGE("Killing process %d", worker_pid(proc));
}
}
#ifdef ACOW
if (number_workers > 1) {
if (kill(GLOBAL_master_worker, SIGINT) != 0)
INFORMATION_MESSAGE("Can't kill process %d", GLOBAL_master_worker);
else
INFORMATION_MESSAGE("Killing process %d", GLOBAL_master_worker);
}
#endif /* ACOW */
}
#endif /* YAPOR */
#ifdef SHM_MEMORY_MAPPING_SCHEME
#ifdef YAPOR
#ifdef ACOW
i = 0;
#else
for (i = 0; i < number_workers + 1; i++)
#endif
#else /* TABLING */
for (i = 0; i < 1 + 2; i++)
#endif /* YAPOR */
{
if (shmctl(shm_mapid[i], IPC_RMID, 0) == 0)
INFORMATION_MESSAGE("Removing shared memory segment %d", shm_mapid[i]);
else INFORMATION_MESSAGE("Can't remove shared memory segment %d", shm_mapid[i]);
}
#else /* MMAP_MEMORY_MAPPING_SCHEME */
strcpy(MapFile,"/tmp/mapfile");
#ifdef YAPOR
#ifdef ACOW
itos(GLOBAL_master_worker, &MapFile[12]);
#else /* ENV_COPY || SBA */
itos(worker_pid(0), &MapFile[12]);
#endif
#else /* TABLING */
itos(getpid(), &MapFile[12]);
#endif /* YAPOR */
if (remove(MapFile) == 0)
INFORMATION_MESSAGE("Removing mapfile \"%s\"", MapFile);
else INFORMATION_MESSAGE("Can't remove mapfile \"%s\"", MapFile);
#endif /* MEMORY_MAPPING_SCHEME */
return;
}
#ifdef YAPOR
void remap_memory(void) {
#ifdef ACOW
/* do nothing */
#endif /* ACOW */
#ifdef SBA
/* setup workers so that they have different areas */
long WorkerArea = worker_offset(1);
GlobalBase += worker_id * WorkerArea;
TrailBase += worker_id * WorkerArea;
LocalBase += worker_id * WorkerArea;
TrailTop += worker_id * WorkerArea;
AuxTop += worker_id * WorkerArea;
AuxSp = (CELL *) AuxTop;
#endif /* SBA */
#ifdef ENV_COPY
void *remap_addr;
long remap_offset;
long WorkerArea;
int i;
remap_addr = worker_area(0);
remap_offset = remap_addr - BaseWorkArea;
WorkerArea = worker_offset(1);
#ifdef SHM_MEMORY_MAPPING_SCHEME
for (i = 0; i < number_workers; i++) {
if (shmdt(worker_area(i)) == -1)
abort_optyap("shmdt error in function remap_memory");
}
for (i = 0; i < number_workers; i++) {
worker_area(i) = remap_addr + ((number_workers + i - worker_id) % number_workers) * WorkerArea;
if(shmat(shm_mapid[i], worker_area(i), 0) == (void *) -1)
abort_optyap("shmat error in function remap_memory at %p: %s", worker_area(i), strerror(errno));
}
#else /* MMAP_MEMORY_MAPPING_SCHEME */
if (munmap(remap_addr, (size_t)(WorkerArea * number_workers)) == -1)
abort_optyap("munmap error in function remap_memory");
for (i = 0; i < number_workers; i++) {
worker_area(i) = remap_addr + ((number_workers + i - worker_id) % number_workers) * WorkerArea;
if (mmap(worker_area(i), (size_t)WorkerArea, PROT_READ|PROT_WRITE,
MAP_SHARED|MAP_FIXED, fd_mapfile, remap_offset + i * WorkerArea) == (void *) -1)
abort_optyap("mmap error in function remap_memory: %s", strerror(errno));
}
#endif /* MEMORY_MAPPING_SCHEME */
for (i = 0; i < number_workers; i++) {
worker_offset(i) = worker_area(i) - worker_area(worker_id);
}
#endif /* ENV_COPY */
}
#endif /* YAPOR */
#ifdef DEAD_CODE
This code is pretty much dead, the idea is to allocate large memory
blocks from the Heap.
void *alloc_memory_block(int size) {
void *block;
LOCK(Pg_lock(GLOBAL_PAGES_void));
#if USE_HEAP_FOR_ALLOC_MEMORY_BLOCKS
block = (void *) AllocCodeSpace(size);
#else
if (size > TopAllocBlockArea - TopAllocArea)
abort_optyap("no more free alloc space (alloc_memory_block)");
TopAllocBlockArea -= size;
block = TopAllocBlockArea;
#endif /* USE_HEAP_FOR_ALLOC_MEMORY_BLOCKS */
UNLOCK(Pg_lock(GLOBAL_PAGES_void));
return block;
}
void free_memory_block(void *block) {
#if USE_HEAP_FOR_ALLOC_MEMORY_BLOCKS
LOCK(Pg_lock(GLOBAL_PAGES_void));
FreeCodeSpace((char *) block);
UNLOCK(Pg_lock(GLOBAL_PAGES_void));
#endif /* USE_HEAP_FOR_ALLOC_MEMORY_BLOCKS */
}
void reset_alloc_block_area(void) {
#if USE_HEAP_FOR_ALLOC_MEMORY_BLOCKS
TopAllocBlockArea = BaseAllocArea+OPT_CHUNK_SIZE;
#endif /* USE_HEAP_FOR_ALLOC_MEMORY_BLOCKS */
}
#endif /* USE_HEAP */
#endif /* YAPOR || TABLING */

205
OPTYap/opt.misc.c Normal file
View File

@@ -0,0 +1,205 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#if defined(YAPOR) || defined(TABLING)
#include <stdarg.h>
#include <stdio.h>
#include "Yatom.h"
#include "yapio.h"
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
/* ------------------------------------------- **
** Global variables are defined here **
** ------------------------------------------- */
struct global_data *GLOBAL;
struct local_data *LOCAL;
#ifdef YAPOR
struct local_data *REMOTE[MAX_WORKERS];
struct worker WORKER;
#endif /* YAPOR */
/* -------------------------- **
** Global functions **
** -------------------------- */
void abort_optyap(const char *msg, ...) {
va_list args;
va_start(args, msg);
fprintf(stderr, "[ ");
#ifdef YAPOR
fprintf (stderr, "Worker %d ", worker_id);
#endif /* YAPOR */
fprintf (stderr, "Aborting OPTYap -> ");
vfprintf(stderr, msg, args);
fprintf(stderr, " ]\n");
#ifdef YAPOR
unmap_memory();
#endif
exit (1);
}
void itos(int i, char *s) {
int n,r,j;
n = 10;
while (n <= i) n *= 10;
j = 0;
while (n > 1) {
n = n / 10;
r = i / n;
i = i - r * n;
s[j++] = r + '0';
}
s[j] = 0;
return;
}
void information_message(const char *mesg,...) {
va_list args;
va_start(args, mesg);
fprintf(stdout, "[ ");
vfprintf(stdout, mesg, args);
fprintf(stdout, " ]\n");
return;
}
/* ------------------------- **
** Local functions **
** ------------------------- */
int tabling_putchar(int sno, int ch) {
return(YP_putc(ch, stderr));
}
#endif /* TABLING_DEBUG */
#ifdef YAPOR
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
void error_message(const char *mesg, ...) {
va_list args;
va_start(args, mesg);
#ifdef YAPOR
LOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR */
fprintf(stderr, "[ ");
#ifdef YAPOR
fprintf(stderr, "W%d: ", worker_id);
#endif /* YAPOR */
fprintf(stderr, "Potencial Error -> ");
vfprintf(stderr, mesg, args);
fprintf(stderr, " ]\n");
#ifdef YAPOR
UNLOCK(GLOBAL_LOCKS_stderr_messages);
#endif /* YAPOR */
return;
}
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
#ifdef YAPOR
#ifdef sparc
void rw_lock_voodoo(void) {
/* code taken from the Linux kernel, it handles shifting between locks */
/* Read/writer locks, as usual this is overly clever to make it as fast as possible. */
/* caches... */
__asm__ __volatile__("
___rw_read_enter_spin_on_wlock:
orcc %g2, 0x0, %g0
be,a ___rw_read_enter
ldstub [%g1 + 3], %g2
b ___rw_read_enter_spin_on_wlock
ldub [%g1 + 3], %g2
___rw_read_exit_spin_on_wlock:
orcc %g2, 0x0, %g0
be,a ___rw_read_exit
ldstub [%g1 + 3], %g2
b ___rw_read_exit_spin_on_wlock
ldub [%g1 + 3], %g2
___rw_write_enter_spin_on_wlock:
orcc %g2, 0x0, %g0
be,a ___rw_write_enter
ldstub [%g1 + 3], %g2
b ___rw_write_enter_spin_on_wlock
ld [%g1], %g2
.globl ___rw_read_enter
___rw_read_enter:
orcc %g2, 0x0, %g0
bne,a ___rw_read_enter_spin_on_wlock
ldub [%g1 + 3], %g2
ld [%g1], %g2
add %g2, 1, %g2
st %g2, [%g1]
retl
mov %g4, %o7
.globl ___rw_read_exit
___rw_read_exit:
orcc %g2, 0x0, %g0
bne,a ___rw_read_exit_spin_on_wlock
ldub [%g1 + 3], %g2
ld [%g1], %g2
sub %g2, 0x1ff, %g2
st %g2, [%g1]
retl
mov %g4, %o7
.globl ___rw_write_enter
___rw_write_enter:
orcc %g2, 0x0, %g0
bne ___rw_write_enter_spin_on_wlock
ld [%g1], %g2
andncc %g2, 0xff, %g0
bne,a ___rw_write_enter_spin_on_wlock
stb %g0, [%g1 + 3]
retl
mov %g4, %o7
");
}
#endif /* sparc */
#ifdef i386
asm(
"
.align 4
.globl __write_lock_failed
__write_lock_failed:
lock; addl $" RW_LOCK_BIAS_STR ",(%eax)
1: cmpl $" RW_LOCK_BIAS_STR ",(%eax)
jne 1b
lock; subl $" RW_LOCK_BIAS_STR ",(%eax)
jnz __write_lock_failed
ret
.align 4
.globl __read_lock_failed
__read_lock_failed:
lock ; incl (%eax)
1: cmpl $1,(%eax)
js 1b
lock ; decl (%eax)
js __read_lock_failed
ret
"
);
#endif /* i386 */
#endif /* YAPOR */
#endif /* YAPOR || TABLING */

830
OPTYap/opt.preds.c Normal file
View File

@@ -0,0 +1,830 @@
/* ----------------------------------------------- **
** Includes, defines and local variables **
** ----------------------------------------------- */
#include "Yap.h"
#if defined(YAPOR) || defined(TABLING)
#include <stdio.h>
#include "Yatom.h"
#include "Heap.h"
#include "yapio.h"
#ifdef YAPOR
#if HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#include "or.macros.h"
#endif /* YAPOR */
#ifdef TABLING
#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 **
** ------------------------------------- */
#ifdef YAPOR
static realtime current_time(void);
static int yapor_on(void);
static int start_yapor(void);
static int p_sequential(void);
static int p_default_sequential(void);
static int p_execution_mode(void);
static int p_performance(void);
static int p_parallel_new_answer(void);
static int p_parallel_yes_answer(void);
static int parallel_new_answer_putchar(int sno, int ch);
static void show_answers(void);
static void answer_to_stdout(char *answer);
#endif /* YAPOR */
#ifdef TABLING
static int p_table(void);
static int p_abolish_trie(void);
static int p_show_trie(void);
#endif /* TABLING */
#ifdef STATISTICS
static int p_show_frames(void);
#endif /* STATISTICS */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
static int p_debug_prolog(void);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
/* -------------------------- **
** Global functions **
** -------------------------- */
void init_optyap_preds(void) {
#ifdef YAPOR
InitCPred("$yapor_on", 0, yapor_on, SafePredFlag);
InitCPred("$start_yapor", 0, start_yapor, SafePredFlag);
InitCPred("$sequential", 1, p_sequential, SafePredFlag);
InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag);
InitCPred("execution_mode", 1, p_execution_mode, SafePredFlag);
InitCPred("performance", 1, p_performance, SafePredFlag);
InitCPred("$parallel_new_answer", 1, p_parallel_new_answer, SafePredFlag);
InitCPred("$parallel_yes_answer", 0, p_parallel_yes_answer, SafePredFlag);
#endif /* YAPOR */
#ifdef TABLING
InitCPred("$table", 1, p_table, SafePredFlag);
InitCPred("$abolish_trie", 1, p_abolish_trie, SafePredFlag);
InitCPred("$show_trie", 2, p_show_trie, SafePredFlag);
#endif /* TABLING */
#ifdef STATISTICS
InitCPred("show_frames", 0, p_show_frames, SafePredFlag);
#endif /* STATISTICS */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
InitCPred("debug_prolog", 1, p_debug_prolog, SafePredFlag);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
}
#ifdef YAPOR
void finish_yapor(void) {
GLOBAL_execution_time = current_time() - GLOBAL_execution_time;
show_answers();
return;
}
#endif /* YAPOR */
/* ------------------------- **
** Local functions **
** ------------------------- */
#ifdef YAPOR
static
realtime current_time(void) {
/* to get time as Yap */
/*
double now, interval;
cputime_interval(&now, &interval);
return ((realtime)now);
*/
struct timeval tempo;
gettimeofday(&tempo, NULL);
return ((realtime)tempo.tv_sec + (realtime)tempo.tv_usec / TIME_RESOLUTION);
}
static
int yapor_on(void) {
return (PARALLEL_EXECUTION_MODE);
}
static
int start_yapor(void) {
#ifdef TIMESTAMP_CHECK
GLOBAL_timestamp = 0;
#endif /* TIMESTAMP_CHECK */
GLOBAL_answers = NO_ANSWER;
BITMAP_delete(GLOBAL_bm_idle_workers, 0);
BITMAP_clear(GLOBAL_bm_invisible_workers);
BITMAP_clear(GLOBAL_bm_requestable_workers);
#ifdef TABLING_INNER_CUTS
BITMAP_clear(GLOBAL_bm_pruning_workers);
#endif /* TABLING_INNER_CUTS */
make_root_choice_point();
GLOBAL_execution_time = current_time();
BITMAP_clear(GLOBAL_bm_finished_workers);
PUT_IN_EXECUTING(worker_id);
return (TRUE);
}
static
int p_sequential(void) {
Term t;
Atom at;
int arity;
PredEntry *pe;
t = Deref(ARG1);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
} else if (IsApplTerm(t)) {
Functor func = FunctorOfTerm(t);
at = NameOfFunctor(func);
arity = ArityOfFunctor(func);
} else {
abort_optyap("unknown term in function p_sequential");
at = NULL; /* just to avoid gcc warning */
arity = 0; /* just to avoid gcc warning */
}
pe = RepPredProp(PredProp(at, arity));
pe->PredFlags |= SequentialPredFlag;
return (TRUE);
}
static
int p_default_sequential(void) {
Term t;
t = Deref(ARG1);
if (IsVarTerm(t)) {
Term ta;
if (SEQUENTIAL_IS_DEFAULT)
ta = MkAtomTerm(LookupAtom("on"));
else
ta = MkAtomTerm(LookupAtom("off"));
Bind((CELL *)t, ta);
return(TRUE);
}
if (IsAtomTerm(t)) {
char *s;
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s, "on") == 0) {
SEQUENTIAL_IS_DEFAULT = TRUE;
return(TRUE);
}
if (strcmp(s,"off") == 0) {
SEQUENTIAL_IS_DEFAULT = FALSE;
return(TRUE);
}
}
return(FALSE);
}
static
int p_execution_mode(void) {
Term t;
t = Deref(ARG1);
if (IsVarTerm(t)) {
Term ta;
if (PARALLEL_EXECUTION_MODE)
ta = MkAtomTerm(LookupAtom("parallel"));
else
ta = MkAtomTerm(LookupAtom("sequential"));
Bind((CELL *)t, ta);
return(TRUE);
}
if (IsAtomTerm(t)) {
char *s;
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s,"parallel") == 0) {
PARALLEL_EXECUTION_MODE = TRUE;
return(TRUE);
}
if (strcmp(s,"sequential") == 0) {
PARALLEL_EXECUTION_MODE = FALSE;
return(TRUE);
}
}
return(FALSE);
}
static
int p_performance(void) {
Term t;
realtime one_worker_execution_time = 0;
int i;
GLOBAL_performance_mode |= PERFORMANCE_IN_EXECUTION;
t = Deref(ARG1);
if (IsVarTerm(t)) {
Term ta;
if (GLOBAL_performance_mode & PERFORMANCE_ON) {
ta = MkAtomTerm(LookupAtom("on"));
} else {
ta = MkAtomTerm(LookupAtom("off"));
}
Bind((CELL *)t, ta);
return(TRUE);
}
if (IsAtomTerm(t)) {
char *s;
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s, "on") == 0) {
GLOBAL_performance_mode |= PERFORMANCE_ON;
return(TRUE);
}
if (strcmp(s,"off") == 0) {
GLOBAL_performance_mode &= ~PERFORMANCE_ON;
return(TRUE);
}
if (strcmp(s,"clear") == 0) {
GLOBAL_number_goals = 0;
GLOBAL_best_times(0) = 0;
return(TRUE);
}
}
if (IsIntTerm(t))
one_worker_execution_time = IntOfTerm(t);
else if (IsFloatTerm(t))
one_worker_execution_time = FloatOfTerm(t);
else
return(FALSE);
if (GLOBAL_number_goals) {
fprintf(stdout, "[\n Best execution times:\n");
for (i = 1; i <= GLOBAL_number_goals; i++) {
fprintf(stdout, " %d. time: %f seconds", i, GLOBAL_best_times(i));
if (one_worker_execution_time != 0)
fprintf(stdout, " --> speedup %f (%6.2f %% )\n",
one_worker_execution_time / GLOBAL_best_times(i),
one_worker_execution_time / GLOBAL_best_times(i) / number_workers * 100 );
else fprintf(stdout, "\n");
}
fprintf(stdout, " Average : %f seconds",
GLOBAL_best_times(0) / GLOBAL_number_goals);
if (one_worker_execution_time != 0)
fprintf(stdout, " --> speedup %f (%6.2f %% )",
one_worker_execution_time * GLOBAL_number_goals / GLOBAL_best_times(0),
one_worker_execution_time * GLOBAL_number_goals / GLOBAL_best_times(0) / number_workers * 100 );
if (GLOBAL_number_goals >= 3) {
fprintf(stdout, "\n Average (best three): %f seconds",
(GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)) / 3);
if (one_worker_execution_time != 0)
fprintf(stdout, " --> speedup %f (%6.2f %% ) ]\n\n",
one_worker_execution_time * 3 / (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)),
one_worker_execution_time * 3 / (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)) / number_workers * 100 );
else fprintf(stdout, "\n]\n\n");
} else fprintf(stdout, "\n]\n\n");
return (TRUE);
}
return (FALSE);
}
static
int p_parallel_new_answer(void) {
or_fr_ptr leftmost_or_fr;
length_answer = 0;
ALLOC_QG_ANSWER_FRAME(actual_answer);
plwrite(ARG1, parallel_new_answer_putchar, 4);
AnsFr_answer(actual_answer)[length_answer] = 0;
AnsFr_next(actual_answer) = NULL;
leftmost_or_fr = CUT_leftmost_or_frame();
LOCK_OR_FRAME(leftmost_or_fr);
if (LOCAL_prune_request) {
UNLOCK_OR_FRAME(leftmost_or_fr);
FREE_QG_ANSWER_FRAME(actual_answer);
} else {
CUT_store_answer(leftmost_or_fr, actual_answer);
UNLOCK_OR_FRAME(leftmost_or_fr);
}
return (TRUE);
}
static
int p_parallel_yes_answer(void) {
GLOBAL_answers = YES_ANSWER;
return (TRUE);
}
static
int parallel_new_answer_putchar(int sno, int ch) {
AnsFr_answer(actual_answer)[length_answer++] = ch;
return ch;
}
static
void show_answers(void) {
int i;
if (OrFr_qg_solutions(LOCAL_top_or_fr)) {
qg_ans_fr_ptr aux_answer1, aux_answer2;
aux_answer1 = SolFr_first(OrFr_qg_solutions(LOCAL_top_or_fr));
while (aux_answer1) {
answer_to_stdout(AnsFr_answer(aux_answer1));
aux_answer2 = aux_answer1;
aux_answer1 = AnsFr_next(aux_answer1);
FREE_QG_ANSWER_FRAME(aux_answer2);
GLOBAL_answers++;
}
FREE_QG_SOLUTION_FRAME(OrFr_qg_solutions(LOCAL_top_or_fr));
OrFr_qg_solutions(LOCAL_top_or_fr) = NULL;
}
switch(GLOBAL_answers) {
case YES_ANSWER:
fprintf(stdout, "[ yes");
break;
case NO_ANSWER:
fprintf(stdout, "[ no");
break;
case 1:
fprintf(stdout, "[ 1 answer found");
break;
default:
fprintf(stdout, "[ %d answers found", GLOBAL_answers);
break;
}
fprintf(stdout, " (in %f seconds) ]\n\n", GLOBAL_execution_time);
if (GLOBAL_performance_mode & PERFORMANCE_IN_EXECUTION) {
GLOBAL_performance_mode &= ~PERFORMANCE_IN_EXECUTION;
} else if (GLOBAL_performance_mode == PERFORMANCE_ON) {
for (i = GLOBAL_number_goals; i > 0; i--) {
if (GLOBAL_best_times(i) > GLOBAL_execution_time) {
if (i + 1 < MAX_BEST_TIMES)
GLOBAL_best_times(i + 1) = GLOBAL_best_times(i);
else {
GLOBAL_best_times(0) -= GLOBAL_best_times(i);
}
}
else break;
}
if (i + 1 < MAX_BEST_TIMES) {
GLOBAL_best_times(0) += GLOBAL_execution_time;
GLOBAL_best_times(i + 1) = GLOBAL_execution_time;
if (GLOBAL_number_goals + 1 < MAX_BEST_TIMES)
GLOBAL_number_goals++;
}
}
return;
}
static
void answer_to_stdout(char *answer) {
int length_answer = 0, length_output = 0, caracter, list, par_rectos;
char output[MAX_LENGTH_ANSWER];
while (1) {
length_answer += 2;
while (answer[length_answer] != ']') {
length_answer++;
caracter = 0;
while (answer[length_answer] != ',' && answer[length_answer] != ']')
caracter = caracter * 10 + answer[length_answer++] - '0';
output[length_output++] = caracter;
}
length_answer++;
output[length_output++] = ' ';
output[length_output++] = '=';
output[length_output++] = ' ';
if (answer[length_answer++] == ',') {
list = 1;
output[length_output++] = '[';
} else list = 0;
par_rectos = 1;
while (1) {
if (answer[length_answer] == '[') par_rectos++;
else if (answer[length_answer] == ']' && --par_rectos == 0) break;
output[length_output++] = answer[length_answer++];
}
if (list) output[length_output++] = ']';
if (answer[++length_answer] != ']') {
output[length_output++] = ' ';
output[length_output++] = ';';
output[length_output++] = ' ';
}
else break;
}
output[length_output] = 0;
fprintf(stdout, " %s\n", output);
return;
}
#endif /* YAPOR */
#ifdef TABLING
static
int p_table(void) {
Term t;
Atom at;
int arity;
PredEntry *pe;
tab_ent_ptr te;
sg_node_ptr sg_node;
t = Deref(ARG1);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
} else if (IsApplTerm(t)) {
Functor func = FunctorOfTerm(t);
at = NameOfFunctor(func);
arity = ArityOfFunctor(func);
} else
return (FALSE);
pe = RepPredProp(PredProp(at, arity));
pe->PredFlags |= TabledPredFlag;
new_subgoal_trie_node(sg_node, 0, NULL, NULL, NULL);
new_table_entry(te, sg_node);
pe->TableOfPred = te;
return (TRUE);
}
static
int p_abolish_trie(void) {
Term t;
Atom at;
int arity;
tab_ent_ptr tab_ent;
sg_hash_ptr hash;
sg_node_ptr sg_node;
t = Deref(ARG1);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
} else if (IsApplTerm(t)) {
Functor func = FunctorOfTerm(t);
at = NameOfFunctor(func);
arity = ArityOfFunctor(func);
} else
return (FALSE);
tab_ent = RepPredProp(PredProp(at, arity))->TableOfPred;
hash = TabEnt_hash_chain(tab_ent);
TabEnt_hash_chain(tab_ent) = NULL;
free_subgoal_hash_chain(hash);
sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent));
if (sg_node) {
TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL;
free_subgoal_trie_branch(sg_node, arity);
}
return (TRUE);
}
static
int p_show_trie(void) {
Term t1, t2;
Atom at;
int arity;
PredEntry *pe;
t1 = Deref(ARG1);
if (IsAtomTerm(t1)) {
at = AtomOfTerm(t1);
arity = 0;
} else if (IsApplTerm(t1)) {
Functor func = FunctorOfTerm(t1);
at = NameOfFunctor(func);
arity = ArityOfFunctor(func);
} else
return(FALSE);
pe = RepPredProp(PredProp(at, arity));
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
Term ta = MkAtomTerm(LookupAtom("stdout"));
Bind((CELL *)t2, ta);
show_trie(stdout, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at);
} else if (IsAtomTerm(t2)) {
FILE *file;
char *path = RepAtom(AtomOfTerm(t2))->StrOfAE;
if ((file = fopen(path, "w")) == NULL)
abort_optyap("fopen error in function p_show_trie");
show_trie(file, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at);
fclose(file);
} else
return(FALSE);
return (TRUE);
}
#endif /* TABLING */
#ifdef STATISTICS
static
int p_show_frames(void) {
long cont, pages;
pg_hd_ptr pg_hd;
void *str_ptr;
fprintf(stdout, "[\n");
pages = 0;
#ifdef YAPOR
/* show or frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_or_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_or_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) OrFr_next((or_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Or frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_or_fr) - Pg_str_in_use(GLOBAL_PAGES_or_fr) == cont &&
Pg_str_in_use(GLOBAL_PAGES_or_fr) == 1) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_or_fr), Pg_str_alloc(GLOBAL_PAGES_or_fr),
Pg_str_in_use(GLOBAL_PAGES_or_fr), cont, Pg_requests(GLOBAL_PAGES_or_fr));
/* show query goal solution frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_qg_sol_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_qg_sol_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) SolFr_next((qg_sol_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Query goal solution frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_qg_sol_fr) - Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr) == cont &&
Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr) == 0) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_qg_sol_fr), Pg_str_alloc(GLOBAL_PAGES_qg_sol_fr),
Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr), cont, Pg_requests(GLOBAL_PAGES_qg_sol_fr));
/* show query goal answer frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_qg_ans_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_qg_ans_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) AnsFr_next((qg_ans_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Query goal answer frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_qg_ans_fr) - Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr) == cont &&
Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr) == 0) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_qg_ans_fr), Pg_str_alloc(GLOBAL_PAGES_qg_ans_fr),
Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr), cont, Pg_requests(GLOBAL_PAGES_qg_ans_fr));
#endif /* YAPOR */
#ifdef TABLING_INNER_CUTS
/* show table subgoal solution frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_tg_sol_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_tg_sol_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) SolFr_next((tg_sol_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Table subgoal solution frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_tg_sol_fr) - Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr) == cont &&
Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr) == 0) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_tg_sol_fr), Pg_str_alloc(GLOBAL_PAGES_tg_sol_fr),
Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr), cont, Pg_requests(GLOBAL_PAGES_tg_sol_fr));
/* show table subgoal answer frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_tg_ans_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_tg_ans_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) AnsFr_next((tg_ans_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Table subgoal answer frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_tg_ans_fr) - Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr) == cont &&
Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr) == 0) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_tg_ans_fr), Pg_str_alloc(GLOBAL_PAGES_tg_ans_fr),
Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr), cont, Pg_requests(GLOBAL_PAGES_tg_ans_fr));
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
/* show table entries */
pages += Pg_pg_alloc(GLOBAL_PAGES_tab_ent);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_tab_ent);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) TabEnt_next((tab_ent_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Table entries: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_tab_ent) - Pg_str_in_use(GLOBAL_PAGES_tab_ent) == cont) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_tab_ent), Pg_str_alloc(GLOBAL_PAGES_tab_ent),
Pg_str_in_use(GLOBAL_PAGES_tab_ent), cont, Pg_requests(GLOBAL_PAGES_tab_ent));
/* show subgoal frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_sg_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_sg_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) SgFr_next((sg_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Subgoal frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_sg_fr) - Pg_str_in_use(GLOBAL_PAGES_sg_fr) == cont) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_sg_fr), Pg_str_alloc(GLOBAL_PAGES_sg_fr),
Pg_str_in_use(GLOBAL_PAGES_sg_fr), cont, Pg_requests(GLOBAL_PAGES_sg_fr));
/* show subgoal trie nodes */
pages += Pg_pg_alloc(GLOBAL_PAGES_sg_node);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_sg_node);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) TrNode_next((sg_node_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Subgoal trie nodes: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_sg_node) - Pg_str_in_use(GLOBAL_PAGES_sg_node) == cont) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_sg_node), Pg_str_alloc(GLOBAL_PAGES_sg_node),
Pg_str_in_use(GLOBAL_PAGES_sg_node), cont, Pg_requests(GLOBAL_PAGES_sg_node));
/* show answer trie nodes */
pages += Pg_pg_alloc(GLOBAL_PAGES_ans_node);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_ans_node);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) TrNode_next((ans_node_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Answer trie nodes: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_ans_node) - Pg_str_in_use(GLOBAL_PAGES_ans_node) == cont) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_ans_node), Pg_str_alloc(GLOBAL_PAGES_ans_node),
Pg_str_in_use(GLOBAL_PAGES_ans_node), cont, Pg_requests(GLOBAL_PAGES_ans_node));
/* show subgoal hashes */
pages += Pg_pg_alloc(GLOBAL_PAGES_sg_hash);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_sg_hash);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) Hash_next((sg_hash_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Subgoal hashes: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_sg_hash) - Pg_str_in_use(GLOBAL_PAGES_sg_hash) == cont) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_sg_hash), Pg_str_alloc(GLOBAL_PAGES_sg_hash),
Pg_str_in_use(GLOBAL_PAGES_sg_hash), cont, Pg_requests(GLOBAL_PAGES_sg_hash));
/* show answer hashes */
pages += Pg_pg_alloc(GLOBAL_PAGES_ans_hash);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_ans_hash);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) Hash_next((ans_hash_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Answer hashes: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_ans_hash) - Pg_str_in_use(GLOBAL_PAGES_ans_hash) == cont &&
Pg_pg_alloc(GLOBAL_PAGES_ans_hash) == 0) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_ans_hash), Pg_str_alloc(GLOBAL_PAGES_ans_hash),
Pg_str_in_use(GLOBAL_PAGES_ans_hash), cont, Pg_requests(GLOBAL_PAGES_ans_hash));
/* show dependency frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_dep_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_dep_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) DepFr_next((dep_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Dependency frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_dep_fr) - Pg_str_in_use(GLOBAL_PAGES_dep_fr) == cont &&
Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_dep_fr), Pg_str_alloc(GLOBAL_PAGES_dep_fr),
Pg_str_in_use(GLOBAL_PAGES_dep_fr), cont, Pg_requests(GLOBAL_PAGES_dep_fr));
#endif /* TABLING */
#if defined(YAPOR) && defined(TABLING)
/* show suspension frames */
pages += Pg_pg_alloc(GLOBAL_PAGES_susp_fr);
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_susp_fr);
while (pg_hd) {
str_ptr = PgHd_free_str(pg_hd);
while (str_ptr) {
cont++;
str_ptr = (void *) SuspFr_next((susp_fr_ptr)str_ptr);
}
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Suspension frames: Alloc %ld - In Use %ld - Free %ld (%ld Accesses)\n",
(Pg_str_alloc(GLOBAL_PAGES_susp_fr) - Pg_str_in_use(GLOBAL_PAGES_susp_fr) == cont &&
Pg_str_in_use(GLOBAL_PAGES_susp_fr) == 0) ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_susp_fr), Pg_str_alloc(GLOBAL_PAGES_susp_fr),
Pg_str_in_use(GLOBAL_PAGES_susp_fr), cont, Pg_requests(GLOBAL_PAGES_susp_fr));
#endif /* YAPOR && TABLING */
/* show pages */
cont = 0;
pg_hd = Pg_free_pg(GLOBAL_PAGES_void);
while (pg_hd) {
cont++;
pg_hd = PgHd_next(pg_hd);
}
fprintf(stdout, " %s[%ld] Pages: In Use %ld - Free %ld (%ld Accesses)\n]\n\n",
(Pg_str_alloc(GLOBAL_PAGES_void) - Pg_str_in_use(GLOBAL_PAGES_void) == cont &&
TopAllocArea - BaseAllocArea == PageSize * Pg_str_alloc(GLOBAL_PAGES_void) &&
Pg_str_in_use(GLOBAL_PAGES_void) == pages) ? " ": "*",
Pg_str_alloc(GLOBAL_PAGES_void),
Pg_str_in_use(GLOBAL_PAGES_void), cont, Pg_requests(GLOBAL_PAGES_void));
return (TRUE);
}
#endif /* STATISTICS */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
static
int p_debug_prolog(void) {
Term t;
t = Deref(ARG1);
if (IsAtomTerm(t)) {
char *s;
s = RepAtom(AtomOfTerm(t))->StrOfAE;
fprintf(stdout, "W%d: %s\n", worker_id, s);
return(TRUE);
} else {
return (FALSE);
}
}
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
#endif /* YAPOR || TABLING */

151
OPTYap/opt.proto.h Normal file
View File

@@ -0,0 +1,151 @@
/* -------------------------------------- **
** Prototypes for opt.*.c files **
** -------------------------------------- */
/* -------------- **
** opt.memory.c **
** -------------- */
long global_data_size(void);
long local_data_size(void);
#ifdef SHM_MEMORY_MAPPING_SCHEME
void shm_map_memory(int id, int size, void *shmaddr);
#else /* MMAP_MEMORY_MAPPING_SCHEME */
void open_mapfile(long);
#endif /* MEMORY_MAPPING_SCHEME */
void close_mapfile(void);
void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_workers);
void unmap_memory(void);
#ifdef YAPOR
void remap_memory(void);
#endif /* YAPOR */
/* ------------ **
** opt.misc.c **
** ------------ */
void abort_optyap(const char *msg, ...);
void itos(int i, char *s);
void information_message(const char *mesg,...);
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
void error_message(const char *mesg, ...);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
/* ------------ **
** opt.init.c **
** ------------ */
void init_global(int n_workers, int sch_loop, int delay_load);
void init_local(void);
void make_root_frames(void);
#ifdef YAPOR
void init_workers(void);
#endif /* YAPOR */
void init_signals(void);
/* ------------- **
** opt.preds.c **
** ------------- */
void init_optyap_preds(void);
#ifdef YAPOR
void finish_yapor(void);
#endif /* YAPOR */
/* -------------------------------------- **
** Prototypes for tab.*.c files **
** -------------------------------------- */
/* ------------- **
** tab.tries.c **
** ------------- */
#ifdef TABLING
#include <stdio.h>
sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr);
ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr);
void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr);
void private_completion(sg_fr_ptr sg_fr);
void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes);
void free_answer_trie(sg_fr_ptr sg_fr);
void update_answer_trie(sg_fr_ptr sg_fr);
void show_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom);
int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity);
int show_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index);
#endif /* TABLING */
/* --------------- **
** tab.suspend.c **
** --------------- */
#if defined(TABLING) && defined(YAPOR)
void public_completion(void);
void complete_suspension_frames(or_fr_ptr or_fr);
void suspend_branch(void);
void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr);
#endif /* TABLING && YAPOR */
/* ------------------------------------- **
** Prototypes for or.*.c files **
** ------------------------------------- */
/* ------------- **
** or.engine.c **
** ------------- */
#ifdef ENV_COPY
void make_root_choice_point(void);
void free_root_choice_point(void);
int q_share_work(int p);
void p_share_work(void);
#endif /* ENV_COPY */
/* ---------------- **
** or.cowengine.c **
** ---------------- */
#ifdef ACOW
void make_root_choice_point(void);
void free_root_choice_point(void);
int q_share_work(int p);
int p_share_work(void);
#endif /* ACOW */
/* ---------------- **
** or.sbaengine.c **
** ---------------- */
#ifdef SBA
void make_root_choice_point(void);
void free_root_choice_point(void);
int q_share_work(int p);
void p_share_work(void);
#endif /* SBA */
/* ---------------- **
** or.scheduler.c **
** ---------------- */
#ifdef YAPOR
int get_work(void);
#endif /* YAPOR */
/* ---------- **
** or.cut.c **
** ---------- */
#ifdef YAPOR
void prune_shared_branch(choiceptr prune_cp);
#endif /* YAPOR */

354
OPTYap/opt.structs.h Normal file
View File

@@ -0,0 +1,354 @@
/* ----------------- **
** Typedefs **
** ----------------- */
typedef double realtime;
typedef volatile int lockvar;
typedef unsigned long bitmap;
#define MAX_WORKERS (sizeof(bitmap) * 8 - 1)
/* ---------------------------- **
** Struct page_header **
** ---------------------------- */
typedef struct page_header {
volatile int structs_in_use;
void *next_free_struct;
struct page_header *previous;
struct page_header *next;
} *pg_hd_ptr;
#define PgHd_str_in_use(X) ((X)->structs_in_use)
#define PgHd_free_str(X) ((X)->next_free_struct)
#define PgHd_previous(X) ((X)->previous)
#define PgHd_next(X) ((X)->next)
/* ---------------------- **
** Struct pages **
** ---------------------- */
struct pages {
#ifdef YAPOR
lockvar lock;
#endif /* YAPOR */
#ifdef STATISTICS
volatile long pages_allocated;
volatile long structs_allocated;
volatile long structs_in_use;
volatile long requests;
#endif /* STATISTICS */
int structs_per_page;
struct page_header *free_pages;
};
#define Pg_lock(X) ((X).lock)
#define Pg_pg_alloc(X) ((X).pages_allocated)
#define Pg_str_alloc(X) ((X).structs_allocated)
#define Pg_str_in_use(X) ((X).structs_in_use)
#define Pg_requests(X) ((X).requests)
#define Pg_str_per_pg(X) ((X).structs_per_page)
#define Pg_free_pg(X) ((X).free_pages)
/* ----------------------------- **
** Struct global_pages **
** ----------------------------- */
struct global_pages {
struct pages void_pages;
#ifdef YAPOR
struct pages or_frame_pages;
struct pages query_goal_solution_frame_pages;
struct pages query_goal_answer_frame_pages;
#endif /* YAPOR */
#ifdef TABLING_INNER_CUTS
struct pages table_subgoal_solution_frame_pages;
struct pages table_subgoal_answer_frame_pages;
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
struct pages table_entry_pages;
struct pages subgoal_frame_pages;
struct pages subgoal_trie_node_pages;
struct pages answer_trie_node_pages;
struct pages subgoal_hash_pages;
struct pages answer_hash_pages;
struct pages dependency_frame_pages;
#endif /* TABLING */
#if defined(YAPOR) && defined(TABLING)
struct pages suspension_frame_pages;
#endif /* YAPOR && TABLING */
};
/* ----------------------------- **
** Struct global_locks **
** ----------------------------- */
#ifdef YAPOR
struct global_locks {
lockvar bitmap_idle_workers;
lockvar bitmap_root_cp_workers;
lockvar bitmap_invisible_workers;
lockvar bitmap_requestable_workers;
lockvar bitmap_executing_workers;
lockvar bitmap_finished_workers;
#ifdef TABLING_INNER_CUTS
lockvar bitmap_pruning_workers;
#endif /* TABLING_INNER_CUTS */
lockvar who_locked_heap;
lockvar heap_access;
lockvar alloc_block;
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
lockvar stderr_messages;
#endif /* YAPOR_ERRORS || TABLING_ERRORS */
};
#endif /* YAPOR */
/* ---------------------------- **
** Struct global_data **
** ---------------------------- */
struct global_data{
/* global data related to memory management */
void *BaseWorkArea;
void *BaseAllocArea;
void *TopAllocArea;
struct global_pages pages;
#ifdef YAPOR
/* global static data */
int scheduler_loop;
int delayed_release_load;
int number_workers;
int worker_pid[MAX_WORKERS];
#ifdef ACOW
int master_worker;
#endif /* ACOW */
/* global data related to or-performance */
realtime execution_time;
realtime best_execution_times[MAX_BEST_TIMES];
int number_of_executed_goals;
char performance_mode; /* PERFORMANCE_OFF / PERFORMANCE_ON / PERFORMANCE_IN_EXECUTION */
/* global data related to or-parallelism */
choiceptr root_choice_point;
struct or_frame *root_or_frame;
bitmap present_workers;
volatile bitmap idle_workers;
volatile bitmap root_cp_workers;
volatile bitmap invisible_workers;
volatile bitmap requestable_workers;
volatile bitmap executing_workers;
volatile bitmap finished_workers;
#ifdef TABLING_INNER_CUTS
volatile bitmap pruning_workers;
#endif /* TABLING_INNER_CUTS */
struct global_locks locks;
volatile unsigned int branch[MAX_WORKERS][MAX_DEPTH];
volatile char parallel_execution_mode; /* TRUE / FALSE */
volatile int answers;
#endif /* YAPOR */
#ifdef TABLING
/* global data related to tabling */
struct dependency_frame *root_dependency_frame;
CELL table_var_enumerator[MAX_TABLE_VARS];
#ifdef TABLE_LOCK_AT_WRITE_LEVEL
lockvar table_lock[TABLE_LOCK_BUCKETS];
#endif /* TABLE_LOCK_AT_WRITE_LEVEL */
#ifdef TIMESTAMP_CHECK
long timestamp;
#endif /* TIMESTAMP_CHECK */
#endif /* TABLING */
};
#define BaseWorkArea (GLOBAL.BaseWorkArea)
#define TopWorkArea (GLOBAL.TopWorkArea)
#define BaseAllocArea (GLOBAL.BaseAllocArea)
#define TopAllocArea (GLOBAL.TopAllocArea)
#define GLOBAL_PAGES_void (GLOBAL.pages.void_pages)
#define GLOBAL_PAGES_or_fr (GLOBAL.pages.or_frame_pages)
#define GLOBAL_PAGES_qg_sol_fr (GLOBAL.pages.query_goal_solution_frame_pages)
#define GLOBAL_PAGES_qg_ans_fr (GLOBAL.pages.query_goal_answer_frame_pages)
#define GLOBAL_PAGES_tg_sol_fr (GLOBAL.pages.table_subgoal_solution_frame_pages)
#define GLOBAL_PAGES_tg_ans_fr (GLOBAL.pages.table_subgoal_answer_frame_pages)
#define GLOBAL_PAGES_tab_ent (GLOBAL.pages.table_entry_pages)
#define GLOBAL_PAGES_sg_fr (GLOBAL.pages.subgoal_frame_pages)
#define GLOBAL_PAGES_sg_node (GLOBAL.pages.subgoal_trie_node_pages)
#define GLOBAL_PAGES_ans_node (GLOBAL.pages.answer_trie_node_pages)
#define GLOBAL_PAGES_sg_hash (GLOBAL.pages.subgoal_hash_pages)
#define GLOBAL_PAGES_ans_hash (GLOBAL.pages.answer_hash_pages)
#define GLOBAL_PAGES_dep_fr (GLOBAL.pages.dependency_frame_pages)
#define GLOBAL_PAGES_susp_fr (GLOBAL.pages.suspension_frame_pages)
#define SCHEDULER_LOOP (GLOBAL.scheduler_loop)
#define DELAYED_RELEASE_LOAD (GLOBAL.delayed_release_load)
#define number_workers (GLOBAL.number_workers)
#define worker_pid(worker) (GLOBAL.worker_pid[worker])
#define GLOBAL_master_worker (GLOBAL.master_worker)
#define GLOBAL_execution_time (GLOBAL.execution_time)
#define GLOBAL_best_times(time) (GLOBAL.best_execution_times[time])
#define GLOBAL_number_goals (GLOBAL.number_of_executed_goals)
#define GLOBAL_performance_mode (GLOBAL.performance_mode)
#define GLOBAL_root_cp (GLOBAL.root_choice_point)
#define GLOBAL_root_or_fr (GLOBAL.root_or_frame)
#define GLOBAL_bm_present_workers (GLOBAL.present_workers)
#define GLOBAL_bm_idle_workers (GLOBAL.idle_workers)
#define GLOBAL_bm_root_cp_workers (GLOBAL.root_cp_workers)
#define GLOBAL_bm_invisible_workers (GLOBAL.invisible_workers)
#define GLOBAL_bm_requestable_workers (GLOBAL.requestable_workers)
#define GLOBAL_bm_executing_workers (GLOBAL.executing_workers)
#define GLOBAL_bm_finished_workers (GLOBAL.finished_workers)
#define GLOBAL_bm_pruning_workers (GLOBAL.pruning_workers)
#define GLOBAL_LOCKS_bm_idle_workers (GLOBAL.locks.bitmap_idle_workers)
#define GLOBAL_LOCKS_bm_root_cp_workers (GLOBAL.locks.bitmap_root_cp_workers)
#define GLOBAL_LOCKS_bm_invisible_workers (GLOBAL.locks.bitmap_invisible_workers)
#define GLOBAL_LOCKS_bm_requestable_workers (GLOBAL.locks.bitmap_requestable_workers)
#define GLOBAL_LOCKS_bm_executing_workers (GLOBAL.locks.bitmap_executing_workers)
#define GLOBAL_LOCKS_bm_finished_workers (GLOBAL.locks.bitmap_finished_workers)
#define GLOBAL_LOCKS_bm_pruning_workers (GLOBAL.locks.bitmap_pruning_workers)
#define GLOBAL_LOCKS_who_locked_heap (GLOBAL.locks.who_locked_heap)
#define GLOBAL_LOCKS_heap_access (GLOBAL.locks.heap_access)
#define GLOBAL_LOCKS_alloc_block (GLOBAL.locks.alloc_block)
#define GLOBAL_LOCKS_stderr_messages (GLOBAL.locks.stderr_messages)
#define GLOBAL_branch(worker, depth) (GLOBAL.branch[worker][depth])
#define PARALLEL_EXECUTION_MODE (GLOBAL.parallel_execution_mode)
#define GLOBAL_answers (GLOBAL.answers)
#define GLOBAL_root_dep_fr (GLOBAL.root_dependency_frame)
#define GLOBAL_table_var_enumerator(index) (GLOBAL.table_var_enumerator[index])
#define GLOBAL_table_lock(index) (GLOBAL.table_lock[index])
#define GLOBAL_timestamp (GLOBAL.timestamp)
/* ------------------------------ **
** Struct local_signals **
** ------------------------------ */
#ifdef YAPOR
struct local_signals{
#ifdef ENV_COPY
lockvar lock;
volatile enum {
Q_idle = 0,
trail = 1,
global = 2,
local = 3,
P_idle = 4
} P_fase, Q_fase;
#endif /* ENV_COPY */
volatile enum {
no_sharing = 0,
sharing = 1,
nodes_shared = 2,
copy_done = 3,
ready = 4
} reply;
};
#endif /* YAPOR */
/* --------------------------- **
** Struct local_data **
** --------------------------- */
struct local_data{
#ifdef YAPOR
/* local data related to or-parallelism */
lockvar lock;
volatile int load;
choiceptr top_choice_point;
struct or_frame *top_or_frame;
choiceptr prune_request;
volatile int share_request;
struct local_signals share_signals;
volatile struct {
CELL start;
CELL end;
} global_copy, local_copy, trail_copy;
#endif /* YAPOR */
#ifdef TABLING
/* local data related to tabling */
struct answer_trie_node *next_free_answer_trie_node;
struct subgoal_frame *top_subgoal_frame;
struct dependency_frame *top_dependency_frame;
#ifdef TABLING_INNER_CUTS
choiceptr bottom_pruning_scope;
#endif /* TABLING_INNER_CUTS */
#ifdef YAPOR
choiceptr top_choice_point_on_stack;
struct or_frame *top_or_frame_with_suspensions;
#endif /* YAPOR */
#endif /* TABLING */
};
extern struct local_data *LOCAL;
#define LOCAL_lock (LOCAL->lock)
#define LOCAL_load (LOCAL->load)
#define LOCAL_top_cp (LOCAL->top_choice_point)
#define LOCAL_top_or_fr (LOCAL->top_or_frame)
#define LOCAL_prune_request (LOCAL->prune_request)
#define LOCAL_share_request (LOCAL->share_request)
#define LOCAL_reply_signal (LOCAL->share_signals.reply)
#define LOCAL_p_fase_signal (LOCAL->share_signals.P_fase)
#define LOCAL_q_fase_signal (LOCAL->share_signals.Q_fase)
#define LOCAL_lock_signals (LOCAL->share_signals.lock)
#define LOCAL_start_global_copy (LOCAL->global_copy.start)
#define LOCAL_end_global_copy (LOCAL->global_copy.end)
#define LOCAL_start_local_copy (LOCAL->local_copy.start)
#define LOCAL_end_local_copy (LOCAL->local_copy.end)
#define LOCAL_start_trail_copy (LOCAL->trail_copy.start)
#define LOCAL_end_trail_copy (LOCAL->trail_copy.end)
#define LOCAL_next_free_ans_node (LOCAL->next_free_answer_trie_node)
#define LOCAL_top_sg_fr (LOCAL->top_subgoal_frame)
#define LOCAL_top_dep_fr (LOCAL->top_dependency_frame)
#define LOCAL_pruning_scope (LOCAL->bottom_pruning_scope)
#define LOCAL_top_cp_on_stack (LOCAL->top_choice_point_on_stack)
#define LOCAL_top_susp_or_fr (LOCAL->top_or_frame_with_suspensions)
#define REMOTE_lock(worker) (REMOTE[worker].lock)
#define REMOTE_load(worker) (REMOTE[worker].load)
#define REMOTE_top_cp(worker) (REMOTE[worker].top_choice_point)
#define REMOTE_top_or_fr(worker) (REMOTE[worker].top_or_frame)
#define REMOTE_prune_request(worker) (REMOTE[worker].prune_request)
#define REMOTE_share_request(worker) (REMOTE[worker].share_request)
#define REMOTE_reply_signal(worker) (REMOTE[worker].share_signals.reply)
#define REMOTE_p_fase_signal(worker) (REMOTE[worker].share_signals.P_fase)
#define REMOTE_q_fase_signal(worker) (REMOTE[worker].share_signals.Q_fase)
#define REMOTE_lock_signals(worker) (REMOTE[worker].share_signals.lock)
#define REMOTE_start_global_copy(worker) (REMOTE[worker].global_copy.start)
#define REMOTE_end_global_copy(worker) (REMOTE[worker].global_copy.end)
#define REMOTE_start_local_copy(worker) (REMOTE[worker].local_copy.start)
#define REMOTE_end_local_copy(worker) (REMOTE[worker].local_copy.end)
#define REMOTE_start_trail_copy(worker) (REMOTE[worker].trail_copy.start)
#define REMOTE_end_trail_copy(worker) (REMOTE[worker].trail_copy.end)
#define REMOTE_next_free_ans_node(worker) (REMOTE[worker].next_free_answer_trie_node)
#define REMOTE_top_sg_fr(worker) (REMOTE[worker].top_subgoal_frame)
#define REMOTE_top_dep_fr(worker) (REMOTE[worker].top_dependency_frame)
#define REMOTE_pruning_scope(worker) (REMOTE[worker].bottom_pruning_scope)
#define REMOTE_top_cp_on_stack(worker) (REMOTE[worker].top_choice_point_on_stack)
#define REMOTE_top_susp_or_fr(worker) (REMOTE[worker].top_or_frame_with_suspensions)
#ifdef YAPOR
#include "or.structs.h"
#endif /* YAPOR */
#ifdef TABLING
#include "tab.structs.h"
#endif /* TABLING */

223
OPTYap/or.cowengine.c Normal file
View File

@@ -0,0 +1,223 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#ifdef ACOW
#include "Yatom.h"
#include "Heap.h"
#include "or.macros.h"
#include <sys/types.h>
#include <unistd.h>
#include <stdio.h>
/* ------------------------------------- **
** Local functions declaration **
** ------------------------------------- */
static void share_private_nodes(int worker_q);
/* ----------------------- **
** Local inlines **
** ----------------------- */
STD_PROTO(static inline void PUT_BUSY, (int));
static inline
void PUT_BUSY(int worker_num) {
LOCK(GLOBAL_LOCKS_bm_idle_workers);
BITMAP_delete(GLOBAL_bm_idle_workers, worker_num);
UNLOCK(GLOBAL_LOCKS_bm_idle_workers);
return;
}
/* -------------------------- **
** Global functions **
** -------------------------- */
void make_root_choice_point(void) {
if (worker_id == 0) {
LOCAL_top_cp = GLOBAL_root_cp = OrFr_node(GLOBAL_root_or_fr) = B;
} else {
B = LOCAL_top_cp = GLOBAL_root_cp;
B->cp_tr = TR = ((choiceptr) (worker_offset(0) + (CELL)(B)))->cp_tr;
}
B->cp_h = H0;
B->cp_ap = GETWORK;
B->cp_or_fr = GLOBAL_root_or_fr;
LOCAL_top_or_fr = GLOBAL_root_or_fr;
LOCAL_load = 0;
LOCAL_prune_request = NULL;
BRANCH(worker_id, 0) = 0;
return;
}
void free_root_choice_point(void) {
B = LOCAL_top_cp->cp_b;
LOCAL_top_cp = B_BASE;
return;
}
int p_share_work(void) {
int worker_q = LOCAL_share_request;
int son;
if (! BITMAP_member(OrFr_members(REMOTE_top_or_fr(worker_q)), worker_id) ||
B == REMOTE_top_cp(worker_q) ||
(LOCAL_load <= DELAYED_RELEASE_LOAD && OrFr_nearest_livenode(LOCAL_top_or_fr) == NULL)) {
/* refuse sharing request */
REMOTE_reply_signal(LOCAL_share_request) = no_sharing;
LOCAL_share_request = MAX_WORKERS;
PUT_OUT_REQUESTABLE(worker_id);
return TRUE;
}
/* sharing request accepted */
REMOTE_reply_signal(worker_q) = sharing;
share_private_nodes(worker_q);
if ((son = fork()) == 0) {
worker_id = worker_q; /* child becomes requesting worker */
LOCAL = REMOTE+worker_id;
LOCAL_reply_signal = ready;
PUT_IN_REQUESTABLE(worker_id);
PUT_BUSY(worker_id);
return FALSE;
} else {
worker_pid(worker_q) = son;
LOCAL_share_request = MAX_WORKERS;
PUT_IN_REQUESTABLE(worker_id);
return TRUE;
}
}
int q_share_work(int worker_p) {
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (REMOTE_prune_request(worker_p)) {
/* worker p with prune request */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
#ifdef YAPOR_ERRORS
if (OrFr_pend_prune_cp(LOCAL_top_or_fr) &&
BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("prune ltt > worker_p branch ltt (q_share_work)");
#endif /* YAPOR_ERRORS */
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
LOCAL_prune_request = NULL;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
/* make sharing request */
LOCK_WORKER(worker_p);
if (BITMAP_member(GLOBAL_bm_idle_workers, worker_p) ||
REMOTE_share_request(worker_p) != MAX_WORKERS) {
/* worker p is idle or has another request */
UNLOCK_WORKER(worker_p);
return FALSE;
}
REMOTE_share_request(worker_p) = worker_id;
UNLOCK_WORKER(worker_p);
/* wait for an answer */
while (LOCAL_reply_signal == ready);
if (LOCAL_reply_signal == no_sharing) {
/* sharing request refused */
LOCAL_reply_signal = ready;
return FALSE;
}
/* exit this process */
exit(0);
}
/* ------------------------- **
** Local functions **
** ------------------------- */
static
void share_private_nodes(int worker_q) {
int depth;
choiceptr AuxB;
or_fr_ptr or_frame, previous_or_frame;
/* initialize auxiliary variables */
AuxB = B;
previous_or_frame = NULL;
depth = OrFr_depth(LOCAL_top_or_fr);
/* sharing loop */
while (AuxB != LOCAL_top_cp) {
depth++;
ALLOC_OR_FRAME(or_frame);
INIT_LOCK(OrFr_lock(or_frame));
OrFr_node(or_frame) = AuxB;
OrFr_alternative(or_frame) = AuxB->cp_ap;
OrFr_pend_prune_cp(or_frame) = NULL;
OrFr_nearest_leftnode(or_frame) = LOCAL_top_or_fr;
OrFr_qg_solutions(or_frame) = NULL;
BITMAP_clear(OrFr_members(or_frame));
BITMAP_insert(OrFr_members(or_frame), worker_id);
BITMAP_insert(OrFr_members(or_frame), worker_q);
if (AuxB->cp_ap && YAMOP_SEQ(AuxB->cp_ap)) {
AuxB->cp_ap = GETWORK_SEQ;
} else {
AuxB->cp_ap = GETWORK;
}
AuxB->cp_or_fr = or_frame;
AuxB = AuxB->cp_b;
if (previous_or_frame) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
previous_or_frame = or_frame;
}
/* initialize last or-frame pointer */
or_frame = AuxB->cp_or_fr;
if (previous_or_frame) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
/* update depth */
if (depth >= MAX_DEPTH)
abort_optyap("maximum depth exceded (%d/%d) (share_private_nodes)", MAX_DEPTH, depth - MAX_DEPTH);
or_frame = B->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) {
unsigned int branch;
if (OrFr_alternative(or_frame)) {
branch = YAMOP_OR_ARG(OrFr_alternative(or_frame)) + 1;
} else {
branch = 1;
}
branch |= YAMOP_CUT_FLAG; /* in doubt, assume cut */
BRANCH(worker_id, depth) = BRANCH(worker_q, depth) = branch;
OrFr_depth(or_frame) = depth--;
or_frame = OrFr_next_on_stack(or_frame);
}
/* update old shared nodes */
while (or_frame != REMOTE_top_or_fr(worker_q)) {
LOCK_OR_FRAME(or_frame);
BRANCH(worker_q, OrFr_depth(or_frame)) = BRANCH(worker_id, OrFr_depth(or_frame));
BITMAP_insert(OrFr_members(or_frame), worker_q);
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
}
/* update top shared nodes */
REMOTE_top_cp(worker_q) = LOCAL_top_cp = B;
REMOTE_top_or_fr(worker_q) = LOCAL_top_or_fr = LOCAL_top_cp->cp_or_fr;
/* update prune request */
if (LOCAL_prune_request) {
CUT_send_prune_request(worker_q, LOCAL_prune_request);
}
/* update load and return */
REMOTE_load(worker_q) = LOCAL_load = 0;
return;
}
#endif /* ACOW */

253
OPTYap/or.cut.c Normal file
View File

@@ -0,0 +1,253 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#ifdef YAPOR
#include "Yatom.h"
#include "Heap.h"
#include "or.macros.h"
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
/* -------------------------- **
** Global functions **
** -------------------------- */
void prune_shared_branch(choiceptr prune_cp) {
int i, ltt, depth;
bitmap members;
choiceptr leftmost_cp;
or_fr_ptr leftmost_or_fr;
qg_sol_fr_ptr qg_solutions, aux_qg_solutions;
#ifdef TABLING_INNER_CUTS
tg_sol_fr_ptr tg_solutions, aux_tg_solutions;
#endif /* TABLING_INNER_CUTS */
leftmost_or_fr = CUT_leftmost_or_frame();
leftmost_cp = OrFr_node(leftmost_or_fr);
qg_solutions = NULL;
#ifdef TABLING_INNER_CUTS
tg_solutions = NULL;
#endif /* TABLING_INNER_CUTS */
if (EQUAL_OR_YOUNGER_CP(prune_cp, leftmost_cp)) {
/* pruning being leftmost */
or_fr_ptr prune_or_fr;
/* send prune requests */
prune_or_fr = prune_cp->cp_or_fr;
depth = OrFr_depth(prune_or_fr);
ltt = BRANCH_LTT(worker_id, depth);
LOCK_OR_FRAME(prune_or_fr);
members = OrFr_members(prune_or_fr);
BITMAP_delete(members, worker_id);
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(members, i) && ltt == BRANCH_LTT(i, depth)) {
CUT_send_prune_request(i, prune_cp);
}
}
UNLOCK_OR_FRAME(prune_or_fr);
/* move up to prune_cp */
do {
ltt = BRANCH_LTT(worker_id, OrFr_depth(LOCAL_top_or_fr));
LOCK_OR_FRAME(LOCAL_top_or_fr);
aux_qg_solutions = OrFr_qg_solutions(LOCAL_top_or_fr);
#ifdef TABLING_INNER_CUTS
aux_tg_solutions = OrFr_tg_solutions(LOCAL_top_or_fr);
#endif /* TABLING_INNER_CUTS */
if (BITMAP_alone(OrFr_members(LOCAL_top_or_fr), worker_id)) {
#ifdef TABLING
if (OrFr_suspensions(LOCAL_top_or_fr) || OrFr_owners(LOCAL_top_or_fr) != 1)
pruning_over_tabling_data_structures();
#endif /* TABLING */
FREE_OR_FRAME(LOCAL_top_or_fr);
} else {
OrFr_qg_solutions(LOCAL_top_or_fr) = NULL;
#ifdef TABLING_INNER_CUTS
OrFr_tg_solutions(LOCAL_top_or_fr) = NULL;
#endif /* TABLING_INNER_CUTS */
OrFr_alternative(LOCAL_top_or_fr) = NULL;
BITMAP_delete(OrFr_members(LOCAL_top_or_fr), worker_id);
#ifdef TABLING
OrFr_owners(LOCAL_top_or_fr)--;
#endif /* TABLING */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
}
if ((aux_qg_solutions = CUT_prune_solution_frames(aux_qg_solutions, ltt))) {
CUT_join_answers_in_an_unique_frame(aux_qg_solutions);
SolFr_next(aux_qg_solutions) = qg_solutions;
qg_solutions = aux_qg_solutions;
}
#ifdef TABLING_INNER_CUTS
if ((aux_tg_solutions = CUT_prune_tg_solution_frames(aux_tg_solutions, ltt))) {
CUT_join_tg_solutions(& tg_solutions, aux_tg_solutions);
}
#endif /* TABLING_INNER_CUTS */
SCH_update_local_or_tops();
} while (LOCAL_top_cp != prune_cp);
#ifdef YAPOR_ERRORS
if (LOCAL_prune_request && EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp))
YAPOR_ERROR_MESSAGE("EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp) (prune_shared_branch)");
#endif /* YAPOR_ERRORS */
/* store answers not pruned */
if (qg_solutions)
CUT_join_answers_in_an_unique_frame(qg_solutions);
LOCK_OR_FRAME(leftmost_or_fr);
if (LOCAL_prune_request) {
UNLOCK_OR_FRAME(leftmost_or_fr);
if (qg_solutions)
CUT_free_solution_frame(qg_solutions);
#ifdef TABLING_INNER_CUTS
CUT_free_tg_solution_frames(tg_solutions);
#endif /* TABLING_INNER_CUTS */
} else {
if (qg_solutions)
CUT_store_answers(leftmost_or_fr, qg_solutions);
#ifdef TABLING_INNER_CUTS
if (tg_solutions)
tg_solutions = CUT_store_tg_answers(leftmost_or_fr, tg_solutions, BRANCH_LTT(worker_id, OrFr_depth(leftmost_or_fr)));
#endif /* TABLING_INNER_CUTS */
UNLOCK_OR_FRAME(leftmost_or_fr);
#ifdef TABLING_INNER_CUTS
CUT_validate_tg_answers(tg_solutions);
#endif /* TABLING_INNER_CUTS */
}
} else {
/* pruning not being leftmost */
int prune_more;
prune_more = 1;
/* send prune requests */
depth = OrFr_depth(leftmost_or_fr);
ltt = BRANCH_LTT(worker_id, depth);
LOCK_OR_FRAME(leftmost_or_fr);
members = OrFr_members(leftmost_or_fr);
BITMAP_delete(members, worker_id);
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(members, i)) {
if (ltt >= BRANCH_LTT(i, depth)) {
CUT_send_prune_request(i, leftmost_cp->cp_b);
} else if (BRANCH_CUT(i, depth)) {
prune_more = 0;
}
}
}
UNLOCK_OR_FRAME(leftmost_or_fr);
/* move up to leftmost_cp */
while (LOCAL_top_cp != leftmost_cp) {
ltt = BRANCH_LTT(worker_id, OrFr_depth(LOCAL_top_or_fr));
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (OrFr_pend_prune_cp(LOCAL_top_or_fr))
prune_more = 0;
aux_qg_solutions = OrFr_qg_solutions(LOCAL_top_or_fr);
#ifdef TABLING_INNER_CUTS
aux_tg_solutions = OrFr_tg_solutions(LOCAL_top_or_fr);
#endif /* TABLING_INNER_CUTS */
if (BITMAP_alone(OrFr_members(LOCAL_top_or_fr), worker_id)) {
#ifdef TABLING
if (OrFr_suspensions(LOCAL_top_or_fr) || OrFr_owners(LOCAL_top_or_fr) != 1)
pruning_over_tabling_data_structures();
#endif /* TABLING */
FREE_OR_FRAME(LOCAL_top_or_fr);
} else {
OrFr_qg_solutions(LOCAL_top_or_fr) = NULL;
#ifdef TABLING_INNER_CUTS
OrFr_tg_solutions(LOCAL_top_or_fr) = NULL;
#endif /* TABLING_INNER_CUTS */
OrFr_alternative(LOCAL_top_or_fr) = NULL;
BITMAP_delete(OrFr_members(LOCAL_top_or_fr), worker_id);
#ifdef TABLING
OrFr_owners(LOCAL_top_or_fr)--;
#endif /* TABLING */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
}
if ((aux_qg_solutions = CUT_prune_solution_frames(aux_qg_solutions, ltt))) {
CUT_join_answers_in_an_unique_frame(aux_qg_solutions);
SolFr_next(aux_qg_solutions) = qg_solutions;
qg_solutions = aux_qg_solutions;
}
#ifdef TABLING_INNER_CUTS
if ((aux_tg_solutions = CUT_prune_tg_solution_frames(aux_tg_solutions, ltt))) {
CUT_join_tg_solutions(& tg_solutions, aux_tg_solutions);
}
#endif /* TABLING_INNER_CUTS */
SCH_update_local_or_tops();
}
#ifdef YAPOR_ERRORS
if (LOCAL_prune_request && EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp))
YAPOR_ERROR_MESSAGE("EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp) (prune_shared_branch)");
#endif /* YAPOR_ERRORS */
/* store answers not pruned */
if (qg_solutions)
CUT_join_answers_in_an_unique_frame(qg_solutions);
LOCK_OR_FRAME(leftmost_or_fr);
if (LOCAL_prune_request) {
UNLOCK_OR_FRAME(leftmost_or_fr);
if (qg_solutions)
CUT_free_solution_frame(qg_solutions);
#ifdef TABLING_INNER_CUTS
CUT_free_tg_solution_frames(tg_solutions);
#endif /* TABLING_INNER_CUTS */
} else {
ltt = BRANCH_LTT(worker_id, depth);
if (qg_solutions)
CUT_store_answers(leftmost_or_fr, qg_solutions);
#ifdef TABLING_INNER_CUTS
if (tg_solutions)
tg_solutions = CUT_store_tg_answers(leftmost_or_fr, tg_solutions, ltt);
#endif /* TABLING_INNER_CUTS */
if (OrFr_pend_prune_cp(leftmost_or_fr))
prune_more = 0;
OrFr_alternative(leftmost_or_fr) = NULL;
OrFr_pend_prune_cp(leftmost_or_fr) = prune_cp;
OrFr_pend_prune_ltt(leftmost_or_fr) = ltt;
UNLOCK_OR_FRAME(leftmost_or_fr);
#ifdef TABLING_INNER_CUTS
CUT_validate_tg_answers(tg_solutions);
#endif /* TABLING_INNER_CUTS */
/* continue pruning to prune_cp */
if (prune_more) {
BITMAP_copy(members, OrFr_members(leftmost_or_fr));
leftmost_cp = leftmost_cp->cp_b;
while (leftmost_cp != prune_cp) {
leftmost_or_fr = leftmost_cp->cp_or_fr;
depth = OrFr_depth(leftmost_or_fr);
ltt = BRANCH_LTT(worker_id, depth);
LOCK_OR_FRAME(leftmost_or_fr);
BITMAP_difference(members, OrFr_members(leftmost_or_fr), members);
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(members, i)) {
if (ltt > BRANCH_LTT(i, depth)) {
CUT_send_prune_request(i, leftmost_cp->cp_b);
} else if (BRANCH_CUT(i, depth)) {
UNLOCK_OR_FRAME(leftmost_or_fr);
goto end_prune_more;
}
}
}
OrFr_alternative(leftmost_or_fr) = NULL;
UNLOCK_OR_FRAME(leftmost_or_fr);
BITMAP_copy(members, OrFr_members(leftmost_or_fr));
leftmost_cp = leftmost_cp->cp_b;
}
end_prune_more:
}
}
}
CUT_reset_prune_request();
#ifdef TABLING
LOCAL_top_cp_on_stack = LOCAL_top_cp;
#endif /* TABLING */
return;
}
#endif /* YAPOR */

729
OPTYap/or.engine.c Normal file
View File

@@ -0,0 +1,729 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#ifdef ENV_COPY
#include "Yatom.h"
#include "Heap.h"
#include "or.macros.h"
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#ifdef TABLING
#include "tab.macros.h"
#else
#include "opt.mavar.h"
#endif /* TABLING */
/* ------------------------------------- **
** Local functions declaration **
** ------------------------------------- */
static void share_private_nodes(int worker_q);
/* ---------------------- **
** Local macros **
** ---------------------- */
#define COMPUTE_SEGMENTS_TO_COPY_TO(Q) \
REMOTE_start_global_copy(Q) = (CELL) (REMOTE_top_cp(Q)->cp_h); \
REMOTE_end_global_copy(Q) = (CELL) (B->cp_h); \
REMOTE_start_local_copy(Q) = (CELL) (B); \
REMOTE_end_local_copy(Q) = (CELL) (REMOTE_top_cp(Q)); \
REMOTE_start_trail_copy(Q) = (CELL) (REMOTE_top_cp(Q)->cp_tr); \
REMOTE_end_trail_copy(Q) = (CELL) (TR)
#define P_COPY_GLOBAL_TO(Q) \
memcpy((void *) (worker_offset(Q) + REMOTE_start_global_copy(Q)), \
(void *) REMOTE_start_global_copy(Q), \
(size_t) (REMOTE_end_global_copy(Q) - REMOTE_start_global_copy(Q)))
#define Q_COPY_GLOBAL_FROM(P) \
memcpy((void *) LOCAL_start_global_copy, \
(void *) (worker_offset(P) + LOCAL_start_global_copy), \
(size_t) (LOCAL_end_global_copy - LOCAL_start_global_copy))
#define P_COPY_LOCAL_TO(Q) \
memcpy((void *) (worker_offset(Q) + REMOTE_start_local_copy(Q)), \
(void *) REMOTE_start_local_copy(Q), \
(size_t) (REMOTE_end_local_copy(Q) - REMOTE_start_local_copy(Q)))
#define Q_COPY_LOCAL_FROM(P) \
memcpy((void *) LOCAL_start_local_copy, \
(void *) (worker_offset(P) + LOCAL_start_local_copy), \
(size_t) (LOCAL_end_local_copy - LOCAL_start_local_copy))
#define P_COPY_TRAIL_TO(Q) \
memcpy((void *) (worker_offset(Q) + REMOTE_start_trail_copy(Q)), \
(void *) REMOTE_start_trail_copy(Q), \
(size_t) (REMOTE_end_trail_copy(Q) - REMOTE_start_trail_copy(Q)))
#define Q_COPY_TRAIL_FROM(P) \
memcpy((void *) LOCAL_start_trail_copy, \
(void *) (worker_offset(P) + LOCAL_start_trail_copy), \
(size_t) (LOCAL_end_trail_copy - LOCAL_start_trail_copy))
/* -------------------------- **
** Global functions **
** -------------------------- */
void make_root_choice_point(void) {
if (worker_id == 0) {
LOCAL_top_cp = GLOBAL_root_cp = OrFr_node(GLOBAL_root_or_fr) = B;
} else {
B = LOCAL_top_cp = GLOBAL_root_cp;
B->cp_tr = TR = ((choiceptr) (worker_offset(0) + (CELL)(B)))->cp_tr;
}
B->cp_h = H0;
B->cp_ap = GETWORK;
B->cp_or_fr = GLOBAL_root_or_fr;
LOCAL_top_or_fr = GLOBAL_root_or_fr;
LOCAL_load = 0;
LOCAL_prune_request = NULL;
BRANCH(worker_id, 0) = 0;
#ifdef TABLING_INNER_CUTS
LOCAL_pruning_scope = NULL;
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
LOCAL_top_cp_on_stack = LOCAL_top_cp;
adjust_freeze_registers();
#endif /* TABLING */
}
void free_root_choice_point(void) {
B = LOCAL_top_cp->cp_b;
#ifdef TABLING
LOCAL_top_cp_on_stack =
#endif /* TABLING */
LOCAL_top_cp = GLOBAL_root_cp = OrFr_node(GLOBAL_root_or_fr) = B_BASE;
return;
}
void p_share_work(void) {
int worker_q = LOCAL_share_request;
if (! BITMAP_member(OrFr_members(REMOTE_top_or_fr(worker_q)), worker_id) ||
B == REMOTE_top_cp(worker_q) ||
(LOCAL_load <= DELAYED_RELEASE_LOAD && OrFr_nearest_livenode(LOCAL_top_or_fr) == NULL)) {
/* refuse sharing request */
REMOTE_reply_signal(LOCAL_share_request) = no_sharing;
LOCAL_share_request = MAX_WORKERS;
PUT_OUT_REQUESTABLE(worker_id);
return;
}
/* sharing request accepted */
COMPUTE_SEGMENTS_TO_COPY_TO(worker_q);
REMOTE_q_fase_signal(worker_q) = Q_idle;
REMOTE_p_fase_signal(worker_q) = P_idle;
#ifndef TABLING
/* wait for incomplete installations */
while (LOCAL_reply_signal != ready);
#endif /* TABLING */
LOCAL_reply_signal = sharing;
REMOTE_reply_signal(worker_q) = sharing;
share_private_nodes(worker_q);
REMOTE_reply_signal(worker_q) = nodes_shared;
/* copy local stack ? */
LOCK(REMOTE_lock_signals(worker_q));
if (REMOTE_q_fase_signal(worker_q) < local) {
REMOTE_p_fase_signal(worker_q) = local;
UNLOCK(REMOTE_lock_signals(worker_q));
P_COPY_LOCAL_TO(worker_q);
} else {
UNLOCK(REMOTE_lock_signals(worker_q));
goto sync_with_q;
}
/* copy global stack ? */
LOCK(REMOTE_lock_signals(worker_q));
if (REMOTE_q_fase_signal(worker_q) < global) {
REMOTE_p_fase_signal(worker_q) = global;
UNLOCK(REMOTE_lock_signals(worker_q));
P_COPY_GLOBAL_TO(worker_q);
} else {
UNLOCK(REMOTE_lock_signals(worker_q));
goto sync_with_q;
}
/* copy trail stack ? */
LOCK(REMOTE_lock_signals(worker_q));
if (REMOTE_q_fase_signal(worker_q) < trail) {
REMOTE_p_fase_signal(worker_q) = trail;
UNLOCK(REMOTE_lock_signals(worker_q));
P_COPY_TRAIL_TO(worker_q);
} else UNLOCK(REMOTE_lock_signals(worker_q));
sync_with_q:
REMOTE_reply_signal(worker_q) = copy_done;
while (LOCAL_reply_signal == sharing);
LOCAL_share_request = MAX_WORKERS;
PUT_IN_REQUESTABLE(worker_id);
return;
}
int q_share_work(int worker_p) {
register tr_fr_ptr aux_tr;
register CELL aux_cell;
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (REMOTE_prune_request(worker_p)) {
/* worker p with prune request */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
#ifdef YAPOR_ERRORS
if (OrFr_pend_prune_cp(LOCAL_top_or_fr) &&
BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("prune ltt > worker_p branch ltt (q_share_work)");
#endif /* YAPOR_ERRORS */
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
LOCAL_prune_request = NULL;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
/* unbind variables */
aux_tr = LOCAL_top_cp->cp_tr;
printf("%d: Starting variable unbinding %p---%p\n", worker_id, TR, aux_tr);
#ifdef TABLING_ERRORS
if (TR < aux_tr)
TABLING_ERROR_MESSAGE("TR < aux_tr (q_share_work)");
#endif /* TABLING_ERRORS */
while (aux_tr != TR) {
aux_cell = TrailTerm(--TR);
/* check for global or local variables */
if (IsVarTerm(aux_cell)) {
RESET_VARIABLE(aux_cell);
#ifdef TABLING
} else if (IsPairTerm(aux_cell)) {
/* avoid frozen segments */
aux_cell = (CELL) RepPair(aux_cell);
if ((ADDR) aux_cell >= TrailBase) {
TR = (tr_fr_ptr) aux_cell;
#ifdef TABLING_ERRORS
if (TR > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("TR > TrailTop (q_share_work)");
if (TR < aux_tr)
TABLING_ERROR_MESSAGE("TR < aux_tr (q_share_work)");
#endif /* TABLING_ERRORS */
}
#endif /* TABLING */
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else if (IsApplTerm(aux_cell)) {
CELL *aux_ptr = RepAppl(aux_cell);
Term aux_val = TrailTerm(--aux_tr);
*aux_ptr = aux_val;
#endif
}
}
#ifdef OPTYAP_ERRORS
if (LOCAL_top_cp != LOCAL_top_cp_on_stack)
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp != LOCAL_top_cp_on_stack (q_share_work)");
if (YOUNGER_CP(B_FZ, LOCAL_top_cp))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(B_FZ, LOCAL_top_cp) (q_share_work)");
#endif /* OPTYAP_ERRORS */
#ifdef YAPOR_ERRORS
if (LOCAL_reply_signal != ready)
YAPOR_ERROR_MESSAGE("LOCAL_reply_signal != ready (q_share_work)");
#endif /* YAPOR_ERRORS */
/* make sharing request */
LOCK_WORKER(worker_p);
if (BITMAP_member(GLOBAL_bm_idle_workers, worker_p) ||
REMOTE_share_request(worker_p) != MAX_WORKERS) {
/* worker p is idle or has another request */
UNLOCK_WORKER(worker_p);
return FALSE;
}
REMOTE_share_request(worker_p) = worker_id;
UNLOCK_WORKER(worker_p);
/* wait for an answer */
while (LOCAL_reply_signal == ready);
if (LOCAL_reply_signal == no_sharing) {
/* sharing request refused */
LOCAL_reply_signal = ready;
return FALSE;
}
/* copy trail stack ? */
LOCK(LOCAL_lock_signals);
if (LOCAL_p_fase_signal > trail) {
LOCAL_q_fase_signal = trail;
UNLOCK(LOCAL_lock_signals);
Q_COPY_TRAIL_FROM(worker_p);
} else {
UNLOCK(LOCAL_lock_signals);
goto sync_with_p;
}
/* copy global stack ? */
LOCK(LOCAL_lock_signals);
if (LOCAL_p_fase_signal > global) {
LOCAL_q_fase_signal = global;
UNLOCK(LOCAL_lock_signals);
Q_COPY_GLOBAL_FROM(worker_p);
} else {
UNLOCK(LOCAL_lock_signals);
goto sync_with_p;
}
/* copy local stack ? */
while (LOCAL_reply_signal < nodes_shared);
LOCK(LOCAL_lock_signals);
if (LOCAL_p_fase_signal > local) {
LOCAL_q_fase_signal = local;
UNLOCK(LOCAL_lock_signals);
Q_COPY_LOCAL_FROM(worker_p);
} else UNLOCK(LOCAL_lock_signals);
sync_with_p:
#ifdef TABLING
REMOTE_reply_signal(worker_p) = ready;
#else
REMOTE_reply_signal(worker_p) = copy_done;
#endif /* TABLING */
while (LOCAL_reply_signal != copy_done);
/* install fase --> TR and LOCAL_top_cp->cp_tr are equal */
aux_tr = ((choiceptr) LOCAL_start_local_copy)->cp_tr;
NEW_MAHASH((ma_h_inner_struct *)H);
while (TR != aux_tr) {
aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) {
if (aux_cell < LOCAL_start_global_copy ||
EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) {
#ifdef YAPOR_ERRORS
if ((CELL *)aux_cell < H0)
YAPOR_ERROR_MESSAGE("aux_cell < H0 (q_share_work)");
if ((ADDR)aux_cell > LocalBase)
YAPOR_ERROR_MESSAGE("aux_cell > LocalBase (q_share_work)");
#endif /* YAPOR_ERRORS */
#ifdef TABLING
*((CELL *) aux_cell) = TrailVal(aux_tr);
#else
*((CELL *) aux_cell) = *((CELL *) (worker_offset(worker_p) + aux_cell));
#endif /* TABLING */
}
#ifdef TABLING
} else if (IsPairTerm(aux_cell)) {
/* avoid frozen segments */
aux_cell = (CELL) RepPair(aux_cell);
if ((ADDR) aux_cell >= TrailBase)
aux_tr = (tr_fr_ptr) aux_cell;
#endif /* TABLING */
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else if (IsApplTerm(aux_cell)) {
CELL *cell_ptr = RepAppl(aux_cell);
if (((CELL *)aux_cell < LOCAL_top_cp->cp_h ||
EQUAL_OR_YOUNGER_CP(LOCAL_top_cp, (choiceptr)aux_cell)) &&
!lookup_ma_var(cell_ptr)) {
/* first time we found the variable, let's put the new value */
#ifdef TABLING
*cell_ptr = TrailVal(aux_tr);
#else
*cell_ptr = *((CELL *) (worker_offset(worker_p) + (CELL)cell_ptr));
#endif /* TABLING */
}
/* skip the old value */
aux_tr--;
#endif
}
}
/* update registers and return */
#ifndef TABLING
REMOTE_reply_signal(worker_p) = ready;
#endif /* TABLING */
LOCAL_reply_signal = ready;
PUT_IN_REQUESTABLE(worker_id);
TR = (tr_fr_ptr) LOCAL_end_trail_copy;
#ifdef TABLING
adjust_freeze_registers();
#endif /* TABLING */
return TRUE;
}
/* ------------------------- **
** Local functions **
** ------------------------- */
static
void share_private_nodes(int worker_q) {
choiceptr sharing_node = B;
#ifdef OPTYAP_ERRORS
if (YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack)) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack) (share_private_nodes)");
} else {
choiceptr aux_cp = B;
while (aux_cp != LOCAL_top_cp) {
if (YOUNGER_CP(LOCAL_top_cp, aux_cp)) {
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp not in branch (share_private_nodes)");
break;
}
if (EQUAL_OR_YOUNGER_CP(LOCAL_top_cp_on_stack, aux_cp)) {
OPTYAP_ERROR_MESSAGE("shared frozen segments in branch (share_private_nodes)");
break;
}
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
#ifdef TABLING
/* check if the branch is already shared */
if (EQUAL_OR_YOUNGER_CP(LOCAL_top_cp_on_stack, sharing_node)) {
or_fr_ptr or_frame;
sg_fr_ptr sg_frame;
dep_fr_ptr dep_frame;
#ifdef OPTYAP_ERRORS
{ or_fr_ptr aux_or_fr;
aux_or_fr = LOCAL_top_or_fr;
while (aux_or_fr != REMOTE_top_or_fr(worker_q)) {
if (YOUNGER_CP(OrFr_node(REMOTE_top_or_fr(worker_q)), OrFr_node(aux_or_fr))) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(OrFr_node(REMOTE_top_or_fr(worker_q)), OrFr_node(aux_or_fr)) (share_private_nodes)");
break;
}
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
}
#endif /* OPTYAP_ERRORS */
/* update old shared nodes */
or_frame = LOCAL_top_or_fr;
while (or_frame != REMOTE_top_or_fr(worker_q)) {
LOCK_OR_FRAME(or_frame);
BRANCH(worker_q, OrFr_depth(or_frame)) = BRANCH(worker_id, OrFr_depth(or_frame));
OrFr_owners(or_frame)++;
if (BITMAP_member(OrFr_members(or_frame), worker_id))
BITMAP_insert(OrFr_members(or_frame), worker_q);
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
}
/* update worker Q top subgoal frame */
sg_frame = LOCAL_top_sg_fr;
while (sg_frame && YOUNGER_CP(SgFr_gen_cp(sg_frame), sharing_node)) {
sg_frame = SgFr_next(sg_frame);
}
REMOTE_top_sg_fr(worker_q) = sg_frame;
/* update worker Q top dependency frame */
dep_frame = LOCAL_top_dep_fr;
while (YOUNGER_CP(DepFr_cons_cp(dep_frame), sharing_node)) {
dep_frame = DepFr_next(dep_frame);
}
REMOTE_top_dep_fr(worker_q) = dep_frame;
/* update worker Q top shared nodes */
REMOTE_top_cp_on_stack(worker_q) = REMOTE_top_cp(worker_q) = LOCAL_top_cp;
REMOTE_top_or_fr(worker_q) = LOCAL_top_or_fr;
} else
#endif /* TABLING */
{
int depth;
bitmap bm_workers;
or_fr_ptr or_frame, previous_or_frame;
#ifdef TABLING
choiceptr consumer_cp, next_node_on_branch;
dep_fr_ptr dep_frame;
sg_fr_ptr sg_frame;
CELL *stack, *stack_base, *stack_top;
/* find top dependency frame above current choice point */
dep_frame = LOCAL_top_dep_fr;
while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(dep_frame), sharing_node)) {
dep_frame = DepFr_next(dep_frame);
}
/* initialize tabling auxiliary variables */
consumer_cp = DepFr_cons_cp(dep_frame);
next_node_on_branch = NULL;
stack_top = (CELL *)TrailTop;
stack_base = stack = AuxSp;
#endif /* TABLING */
/* initialize auxiliary variables */
BITMAP_clear(bm_workers);
BITMAP_insert(bm_workers, worker_id);
BITMAP_insert(bm_workers, worker_q);
previous_or_frame = NULL;
depth = OrFr_depth(LOCAL_top_or_fr);
/* sharing loop */
#ifdef TABLING
while (YOUNGER_CP(sharing_node, LOCAL_top_cp_on_stack)) {
#else
while (sharing_node != LOCAL_top_cp) {
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
if (next_node_on_branch) {
choiceptr aux_cp = B;
while (aux_cp != next_node_on_branch) {
if (sharing_node == aux_cp)
OPTYAP_ERROR_MESSAGE("sharing_node on branch (share_private_nodes)");
if (YOUNGER_CP(next_node_on_branch, aux_cp)) {
OPTYAP_ERROR_MESSAGE("next_node_on_branch not in branch (share_private_nodes)");
break;
}
aux_cp = aux_cp->cp_b;
}
} else {
choiceptr aux_cp = B;
while (aux_cp != sharing_node) {
if (YOUNGER_CP(sharing_node, aux_cp)) {
OPTYAP_ERROR_MESSAGE("sharing_node not in branch (share_private_nodes)");
break;
}
aux_cp = aux_cp->cp_b;
}
}
#endif /* OPTYAP_ERRORS */
ALLOC_OR_FRAME(or_frame);
if (previous_or_frame) {
#ifdef TABLING
OrFr_next_on_stack(previous_or_frame) =
#endif /* TABLING */
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
previous_or_frame = or_frame;
depth++;
INIT_LOCK(OrFr_lock(or_frame));
OrFr_node(or_frame) = sharing_node;
OrFr_alternative(or_frame) = sharing_node->cp_ap;
OrFr_pend_prune_cp(or_frame) = NULL;
OrFr_nearest_leftnode(or_frame) = LOCAL_top_or_fr;
OrFr_qg_solutions(or_frame) = NULL;
#ifdef TABLING_INNER_CUTS
OrFr_tg_solutions(or_frame) = NULL;
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
OrFr_suspensions(or_frame) = NULL;
OrFr_nearest_suspnode(or_frame) = or_frame;
OrFr_owners(or_frame) = 2;
if (next_node_on_branch)
BITMAP_clear(OrFr_members(or_frame));
else
#endif /* TABLING */
OrFr_members(or_frame) = bm_workers;
#ifdef YAPOR_ERRORS
if (sharing_node->cp_ap == GETWORK || sharing_node->cp_ap == GETWORK_SEQ)
YAPOR_ERROR_MESSAGE("choicepoint already shared (share_private_nodes)");
#endif /* YAPOR_ERRORS */
if (sharing_node->cp_ap && YAMOP_SEQ(sharing_node->cp_ap)) {
sharing_node->cp_ap = GETWORK_SEQ;
} else {
sharing_node->cp_ap = GETWORK;
}
sharing_node->cp_or_fr = or_frame;
sharing_node = sharing_node->cp_b;
#ifdef TABLING
/* when next_node_on_branch is not NULL the **
** sharing_node belongs to a frozen branch. */
if (YOUNGER_CP(consumer_cp, sharing_node)) {
/* frozen stack segment */
if (! next_node_on_branch)
next_node_on_branch = sharing_node;
STACK_PUSH(or_frame, stack, stack_top);
STACK_PUSH(sharing_node, stack, stack_top);
sharing_node = consumer_cp;
dep_frame = DepFr_next(dep_frame);
consumer_cp = DepFr_cons_cp(dep_frame);
} else if (consumer_cp == sharing_node) {
dep_frame = DepFr_next(dep_frame);
consumer_cp = DepFr_cons_cp(dep_frame);
}
if (next_node_on_branch == sharing_node)
next_node_on_branch = NULL;
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
if (next_node_on_branch && YOUNGER_CP(next_node_on_branch, sharing_node))
OPTYAP_ERROR_MESSAGE("frozen node greater than next_node_on_branch (share_private_nodes)");
#endif /* OPTYAP_ERRORS */
}
/* initialize last or-frame pointer */
or_frame = sharing_node->cp_or_fr;
if (previous_or_frame) {
#ifdef TABLING
OrFr_next_on_stack(previous_or_frame) =
#endif /* TABLING */
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
#ifdef TABLING
/* update or-frames stored in auxiliary stack */
while (STACK_NOT_EMPTY(stack, stack_base)) {
next_node_on_branch = (choiceptr) STACK_POP(stack);
or_frame = (or_fr_ptr) STACK_POP(stack);
OrFr_nearest_livenode(or_frame) = OrFr_next(or_frame) = next_node_on_branch->cp_or_fr;
}
#endif /* TABLING */
/* update depth */
if (depth >= MAX_DEPTH)
abort_optyap("maximum depth exceded (%d/%d) (share_private_nodes)", depth, MAX_DEPTH);
or_frame = B->cp_or_fr;
#ifdef TABLING
previous_or_frame = LOCAL_top_cp_on_stack->cp_or_fr;
while (or_frame != previous_or_frame) {
#else
while (or_frame != LOCAL_top_or_fr) {
#endif /* TABLING */
unsigned int branch;
if (OrFr_alternative(or_frame)) {
branch = YAMOP_OR_ARG(OrFr_alternative(or_frame)) + 1;
} else {
branch = 1;
}
branch |= YAMOP_CUT_FLAG; /* in doubt, assume cut */
BRANCH(worker_id, depth) = BRANCH(worker_q, depth) = branch;
OrFr_depth(or_frame) = depth--;
or_frame = OrFr_next_on_stack(or_frame);
}
#ifdef YAPOR_ERRORS
if (depth != OrFr_depth(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("incorrect depth value (share_private_nodes)");
#endif /* YAPOR_ERRORS */
#ifdef OPTYAP_ERRORS
{ or_fr_ptr aux_or_fr = B->cp_or_fr;
choiceptr aux_cp;
while (aux_or_fr != LOCAL_top_cp_on_stack->cp_or_fr) {
aux_cp = OrFr_node(aux_or_fr);
if (OrFr_next(aux_or_fr) != aux_cp->cp_b->cp_or_fr)
OPTYAP_ERROR_MESSAGE("OrFr_next not in branch (share_private_nodes)");
if (OrFr_nearest_livenode(aux_or_fr) != aux_cp->cp_b->cp_or_fr)
OPTYAP_ERROR_MESSAGE("OrFr_nearest_livenode not in branch (share_private_nodes)");
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
aux_or_fr = B->cp_or_fr;
while (aux_or_fr != LOCAL_top_cp_on_stack->cp_or_fr) {
or_fr_ptr nearest_leftnode = OrFr_nearest_leftnode(aux_or_fr);
aux_cp = OrFr_node(aux_or_fr);
while (OrFr_node(nearest_leftnode) != aux_cp) {
if (YOUNGER_CP(OrFr_node(nearest_leftnode), aux_cp)) {
OPTYAP_ERROR_MESSAGE("OrFr_nearest_leftnode not in branch (share_private_nodes)");
break;
}
aux_cp = aux_cp->cp_b;
}
aux_or_fr = OrFr_next_on_stack(aux_or_fr);
}
}
#endif /* OPTYAP_ERRORS */
/* update old shared nodes */
while (or_frame != REMOTE_top_or_fr(worker_q)) {
LOCK_OR_FRAME(or_frame);
BRANCH(worker_q, OrFr_depth(or_frame)) = BRANCH(worker_id, OrFr_depth(or_frame));
#ifdef TABLING
OrFr_owners(or_frame)++;
if (BITMAP_member(OrFr_members(or_frame), worker_id))
#endif /* TABLING */
BITMAP_insert(OrFr_members(or_frame), worker_q);
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
}
#ifdef TABLING
/* update subgoal frames in the maintained private branches */
sg_frame = LOCAL_top_sg_fr;
while (sg_frame && YOUNGER_CP(SgFr_gen_cp(sg_frame), B)) {
choiceptr top_cp_on_branch;
top_cp_on_branch = SgFr_gen_cp(sg_frame);
while (YOUNGER_CP(top_cp_on_branch, B)) {
top_cp_on_branch = top_cp_on_branch->cp_b;
}
SgFr_gen_top_or_fr(sg_frame) = top_cp_on_branch->cp_or_fr;
sg_frame = SgFr_next(sg_frame);
}
/* update worker Q top subgoal frame */
REMOTE_top_sg_fr(worker_q) = sg_frame;
/* update subgoal frames in the recently shared branches */
while (sg_frame && YOUNGER_CP(SgFr_gen_cp(sg_frame), LOCAL_top_cp_on_stack)) {
SgFr_gen_worker(sg_frame) = MAX_WORKERS;
SgFr_gen_top_or_fr(sg_frame) = GEN_CP(SgFr_gen_cp(sg_frame))->gcp_or_fr;
sg_frame = SgFr_next(sg_frame);
}
/* update dependency frames in the maintained private branches */
dep_frame = LOCAL_top_dep_fr;
while (YOUNGER_CP(DepFr_cons_cp(dep_frame), B)) {
choiceptr top_cp_on_branch;
top_cp_on_branch = DepFr_cons_cp(dep_frame);
while (YOUNGER_CP(top_cp_on_branch, B)) {
top_cp_on_branch = top_cp_on_branch->cp_b;
}
DepFr_top_or_fr(dep_frame) = top_cp_on_branch->cp_or_fr;
dep_frame = DepFr_next(dep_frame);
}
/* update worker Q top dependency frame */
REMOTE_top_dep_fr(worker_q) = dep_frame;
/* update dependency frames in the recently shared branches */
while (YOUNGER_CP(DepFr_cons_cp(dep_frame), LOCAL_top_cp_on_stack)) {
DepFr_top_or_fr(dep_frame) = CONS_CP(DepFr_cons_cp(dep_frame))->ccp_or_fr;
dep_frame = DepFr_next(dep_frame);
}
#endif /* TABLING */
#ifdef OPTYAP_ERRORS
{ dep_fr_ptr aux_dep_fr = LOCAL_top_dep_fr;
while(aux_dep_fr != GLOBAL_root_dep_fr) {
choiceptr top_cp_on_branch;
top_cp_on_branch = DepFr_cons_cp(aux_dep_fr);
while (YOUNGER_CP(top_cp_on_branch, B)) {
top_cp_on_branch = top_cp_on_branch->cp_b;
}
if (top_cp_on_branch->cp_or_fr != DepFr_top_or_fr(aux_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (share_private_nodes)");
aux_dep_fr = DepFr_next(aux_dep_fr);
}
}
#endif /* OPTYAP_ERRORS */
/* update top shared nodes */
#ifdef TABLING
REMOTE_top_cp_on_stack(worker_q) = LOCAL_top_cp_on_stack =
#endif /* TABLING */
REMOTE_top_cp(worker_q) = LOCAL_top_cp = B;
REMOTE_top_or_fr(worker_q) = LOCAL_top_or_fr = LOCAL_top_cp->cp_or_fr;
}
#ifdef TABLING_INNER_CUTS
/* update worker Q pruning scope */
if (LOCAL_pruning_scope && EQUAL_OR_YOUNGER_CP(LOCAL_top_cp, LOCAL_pruning_scope)) {
REMOTE_pruning_scope(worker_q) = LOCAL_pruning_scope;
PUT_IN_PRUNING(worker_q);
} else {
PUT_OUT_PRUNING(worker_q);
REMOTE_pruning_scope(worker_q) = NULL;
}
#endif /* TABLING_INNER_CUTS */
/* update worker Q prune request */
if (LOCAL_prune_request) {
CUT_send_prune_request(worker_q, LOCAL_prune_request);
}
/* update load and return */
REMOTE_load(worker_q) = LOCAL_load = 0;
return;
}
#endif /* ENV_COPY */

94
OPTYap/or.insts.i Normal file
View File

@@ -0,0 +1,94 @@
/* -------------------------------- **
** Scheduler instructions **
** -------------------------------- */
PBOp(getwork_first_time,e)
/* wait for a new parallel goal */
while (BITMAP_same(GLOBAL_bm_present_workers, GLOBAL_bm_finished_workers));
make_root_choice_point();
PUT_IN_EXECUTING(worker_id);
/* wait until everyone else is executing! */
while (! BITMAP_same(GLOBAL_bm_present_workers, GLOBAL_bm_executing_workers));
SCHEDULER_GET_WORK();
shared_end:
PUT_IN_FINISHED(worker_id);
/* wait until everyone else is finished! */
while (! BITMAP_same(GLOBAL_bm_present_workers, GLOBAL_bm_finished_workers));
PUT_OUT_EXECUTING(worker_id);
if (worker_id == 0) {
finish_yapor();
free_root_choice_point();
/* wait until no one is executing */
while (! BITMAP_empty(GLOBAL_bm_executing_workers));
goto fail;
} else {
PREG = GETWORK_FIRST_TIME;
PREFETCH_OP(PREG);
GONext();
}
ENDPBOp();
PBOp(getwork,ld)
#ifdef TABLING
if (DepFr_leader_cp(LOCAL_top_dep_fr) == LOCAL_top_cp) {
/* the current top node is a leader node with consumer nodes below */
if (DepFr_leader_dep_is_on_stack(LOCAL_top_dep_fr)) {
/* the frozen branch depends on the current top node **
** this means that the current top node is a generator node */
LOCK_OR_FRAME(LOCAL_top_or_fr);
#ifdef TABLING_BATCHED_SCHEDULING
if (OrFr_alternative(LOCAL_top_or_fr) != GEN_CP_NULL_ALT) {
#else /* TABLING_LOCAL_SCHEDULING */
if (OrFr_alternative(LOCAL_top_or_fr) != GEN_CP_NULL_ALT || B_FZ == LOCAL_top_cp) {
#endif /* TABLING_SCHEDULING */
/* the current top node has unexploited alternatives ---> we should **
** exploit all the available alternatives before execute completion */
PREG = OrFr_alternative(LOCAL_top_or_fr);
PREFETCH_OP(PREG);
GONext();
}
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
}
goto completion;
}
#endif /* TABLING */
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (OrFr_alternative(LOCAL_top_or_fr)) {
PREG = OrFr_alternative(LOCAL_top_or_fr);
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
PREFETCH_OP(PREG);
GONext();
} else {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
SCHEDULER_GET_WORK();
}
ENDPBOp();
/* The idea is to check whether we are the last worker in the node.
If we are, we can go ahead, otherwise we should call the scheduler. */
PBOp(getwork_seq,ld)
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (OrFr_alternative(LOCAL_top_or_fr) &&
BITMAP_alone(OrFr_members(LOCAL_top_or_fr), worker_id)) {
PREG = OrFr_alternative(LOCAL_top_or_fr);
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
PREFETCH_OP(PREG);
GONext();
} else {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
SCHEDULER_GET_WORK();
}
ENDPBOp();
PBOp(sync,ld)
CUT_wait_leftmost();
PREG = NEXTOP(PREG, ld);
PREFETCH_OP(PREG);
GONext();
ENDPBOp();

592
OPTYap/or.macros.h Normal file
View File

@@ -0,0 +1,592 @@
/* -------------------- **
** Prototypes **
** -------------------- */
/* get a def for NULL */
#include <stdlib.h>
STD_PROTO(static inline void PUT_IN_EXECUTING, (int));
STD_PROTO(static inline void PUT_OUT_EXECUTING, (int));
STD_PROTO(static inline void PUT_IN_FINISHED, (int));
#ifdef TABLING_INNER_CUTS
STD_PROTO(static inline void PUT_IN_PRUNING, (int));
STD_PROTO(static inline void PUT_OUT_PRUNING, (int));
#endif /* TABLING_INNER_CUTS */
STD_PROTO(static inline void PUT_IN_REQUESTABLE, (int));
STD_PROTO(static inline void PUT_OUT_REQUESTABLE, (int));
STD_PROTO(static inline void SCH_update_local_or_tops, (void));
STD_PROTO(static inline void SCH_refuse_share_request_if_any, (void));
STD_PROTO(static inline void SCH_set_load, (choiceptr));
STD_PROTO(static inline void SCH_new_alternative, (yamop *,yamop *));
STD_PROTO(static inline void CUT_prune_to, (choiceptr));
STD_PROTO(static inline void CUT_send_prune_request, (int, choiceptr));
STD_PROTO(static inline void CUT_reset_prune_request, (void));
STD_PROTO(static inline int CUT_last_worker_left_pending_prune, (or_fr_ptr));
STD_PROTO(static inline or_fr_ptr CUT_leftmost_or_frame, (void));
#ifdef TABLING_INNER_CUTS
STD_PROTO(static inline or_fr_ptr CUT_leftmost_until, (or_fr_ptr, int));
#endif /* TABLING_INNER_CUTS */
STD_PROTO(static inline void CUT_store_answer, (or_fr_ptr, qg_ans_fr_ptr));
STD_PROTO(static inline void CUT_store_answers, (or_fr_ptr, qg_sol_fr_ptr));
STD_PROTO(static inline void CUT_join_answers_in_an_unique_frame, (qg_sol_fr_ptr));
STD_PROTO(static inline void CUT_free_solution_frame, (qg_sol_fr_ptr));
STD_PROTO(static inline void CUT_free_solution_frames, (qg_sol_fr_ptr));
STD_PROTO(static inline qg_sol_fr_ptr CUT_prune_solution_frames, (qg_sol_fr_ptr, int));
/* ---------------------------- **
** Instruction Macros **
** ---------------------------- */
#if SIZEOF_INT == 2
#define YAMOP_CUT_FLAG 0x8000
#define YAMOP_SEQ_FLAG 0x4000
#define YAMOP_FLAGS_BITS 0xc000
#define YAMOP_LTT_BITS 0x3fff
#elif SIZEOF_INT == 4
#define YAMOP_CUT_FLAG 0x80000000
#define YAMOP_SEQ_FLAG 0x40000000
#define YAMOP_FLAGS_BITS 0xc0000000
#define YAMOP_LTT_BITS 0x3fffffff
#elif SIZEOF_INT == 8
#define YAMOP_CUT_FLAG 0x8000000000000000
#define YAMOP_SEQ_FLAG 0x4000000000000000
#define YAMOP_FLAGS_BITS 0xc000000000000000
#define YAMOP_LTT_BITS 0x3fffffffffffffff
#else
#define YAMOP_CUT_FLAG OOOOPPS!!! Unknown Integer Sizeof
#define YAMOP_SEQ_FLAG OOOOPPS!!! Unknown Integer Sizeof
#define YAMOP_FLAGS_BITS OOOOPPS!!! Unknown Integer Sizeof
#define YAMOP_LTT_BITS OOOOPPS!!! Unknown Integer Sizeof
#endif /* SIZEOF_INT */
#define YAMOP_OR_ARG(INST) ((INST)->u.ld.or_arg)
#define YAMOP_LTT(INST) (((INST)->u.ld.or_arg) & YAMOP_LTT_BITS)
#define YAMOP_SEQ(INST) (((INST)->u.ld.or_arg) & YAMOP_SEQ_FLAG)
#define YAMOP_CUT(INST) (((INST)->u.ld.or_arg) & YAMOP_CUT_FLAG)
#define YAMOP_FLAGS(INST) (((INST)->u.ld.or_arg) & YAMOP_FLAGS_BITS)
#define INIT_YAMOP_LTT(INST, LTT) (INST)->u.ld.or_arg = LTT
#define PUT_YAMOP_LTT(INST, LTT) (INST)->u.ld.or_arg = YAMOP_FLAGS(INST) | (LTT)
#define PUT_YAMOP_SEQ(INST) (INST)->u.ld.or_arg |= YAMOP_SEQ_FLAG
#define PUT_YAMOP_CUT(INST) (INST)->u.ld.or_arg |= YAMOP_CUT_FLAG
#define BRANCH(WORKER, DEPTH) GLOBAL_branch(WORKER, DEPTH)
#define BRANCH_LTT(WORKER, DEPTH) (BRANCH(WORKER, DEPTH) & YAMOP_LTT_BITS)
#define BRANCH_CUT(WORKER, DEPTH) (BRANCH(WORKER, DEPTH) & YAMOP_CUT_FLAG)
/* ---------------------------- **
** Performance Macros **
** ---------------------------- */
#define PERFORMANCE_OFF 0x0
#define PERFORMANCE_ON 0x1
#define PERFORMANCE_IN_EXECUTION 0x2
/* ----------------------- **
** Engine Macros **
** ----------------------- */
#define LOCK_OR_FRAME(fr) LOCK(OrFr_lock(fr))
#define UNLOCK_OR_FRAME(fr) UNLOCK(OrFr_lock(fr))
#define LOCK_WORKER(w) LOCK(REMOTE_lock(w))
#define UNLOCK_WORKER(w) UNLOCK(REMOTE_lock(w))
/* -------------------------- **
** Scheduler Macros **
** -------------------------- */
#define SCH_top_shared_cp(CP) (LOCAL_top_cp == CP)
#define SCH_any_share_request (LOCAL_share_request != MAX_WORKERS)
#define SCHEDULER_GET_WORK() \
if (get_work()) \
goto shared_fail; \
else \
goto shared_end
#define SCH_check_prune_request() \
if (LOCAL_prune_request) { \
SCHEDULER_GET_WORK(); \
}
#if defined(ENV_COPY) || defined(SBA)
#define SCH_check_share_request() \
if (SCH_any_share_request) { \
p_share_work(); \
}
#else /* ACOW */
#define SCH_check_share_request() \
if (SCH_any_share_request) { \
if (! p_share_work()) \
goto shared_fail; \
}
#endif /* ENV_COPY || SBA || ACOW */
#define SCH_check_requests() \
SCH_check_prune_request(); \
SCH_check_share_request()
#define SCH_last_alternative(curpc, CP_PTR) \
H = HBREG = PROTECT_FROZEN_H(CP_PTR); \
CPREG = CP_PTR->cp_cp; \
ENV = CP_PTR->cp_env; \
SCH_new_alternative(curpc, NULL)
/* -------------------- **
** Cut Macros **
** -------------------- */
#define CUT_wait_leftmost() \
if (PARALLEL_EXECUTION_MODE) { \
/* parallel execution mode --> wait until leftmost */ \
int i, loop, depth, ltt; \
bitmap members; \
or_fr_ptr leftmost_or_fr; \
leftmost_or_fr = LOCAL_top_or_fr; \
do { \
depth = OrFr_depth(leftmost_or_fr); \
ltt = BRANCH_LTT(worker_id, depth); \
do { \
loop = FALSE; \
SCH_check_requests(); \
BITMAP_copy(members, OrFr_members(leftmost_or_fr)); \
BITMAP_delete(members, worker_id); \
for (i = 0; i < number_workers; i++) { \
/* not leftmost in current frame if there is a */ \
/* worker in a left branch and it is not idle or */ \
/* if it is idle it is in a younger node */ \
if (BITMAP_member(members, i) && \
BRANCH_LTT(i, depth) > ltt && \
(! BITMAP_member(GLOBAL_bm_idle_workers, i) || \
leftmost_or_fr != REMOTE_top_or_fr(i))) { \
loop = TRUE; \
break; \
} \
} \
} while (loop); \
leftmost_or_fr = OrFr_nearest_leftnode(leftmost_or_fr); \
} while (leftmost_or_fr != GLOBAL_root_or_fr); \
}
/* ---------------------- **
** Engine Stuff **
** ---------------------- */
static inline
void PUT_IN_EXECUTING(int w) {
LOCK(GLOBAL_LOCKS_bm_executing_workers);
BITMAP_insert(GLOBAL_bm_executing_workers, w);
UNLOCK(GLOBAL_LOCKS_bm_executing_workers);
return;
}
static inline
void PUT_OUT_EXECUTING(int w) {
LOCK(GLOBAL_LOCKS_bm_executing_workers);
BITMAP_delete(GLOBAL_bm_executing_workers, w);
UNLOCK(GLOBAL_LOCKS_bm_executing_workers);
return;
}
static inline
void PUT_IN_FINISHED(int w) {
LOCK(GLOBAL_LOCKS_bm_finished_workers);
BITMAP_insert(GLOBAL_bm_finished_workers, w);
UNLOCK(GLOBAL_LOCKS_bm_finished_workers);
return;
}
#ifdef TABLING_INNER_CUTS
static inline
void PUT_IN_PRUNING(int w) {
LOCK(GLOBAL_LOCKS_bm_pruning_workers);
BITMAP_insert(GLOBAL_bm_pruning_workers, w);
UNLOCK(GLOBAL_LOCKS_bm_pruning_workers);
return;
}
static inline
void PUT_OUT_PRUNING(int w) {
LOCK(GLOBAL_LOCKS_bm_pruning_workers);
BITMAP_delete(GLOBAL_bm_pruning_workers, w);
UNLOCK(GLOBAL_LOCKS_bm_pruning_workers);
return;
}
#endif /* TABLING_INNER_CUTS */
/* ------------------------- **
** Scheduler Stuff **
** ------------------------- */
static inline
void PUT_IN_REQUESTABLE(int p) {
LOCK(GLOBAL_LOCKS_bm_requestable_workers);
BITMAP_insert(GLOBAL_bm_requestable_workers, p);
UNLOCK(GLOBAL_LOCKS_bm_requestable_workers);
return;
}
static inline
void PUT_OUT_REQUESTABLE(int p) {
LOCK(GLOBAL_LOCKS_bm_requestable_workers);
BITMAP_delete(GLOBAL_bm_requestable_workers, p);
UNLOCK(GLOBAL_LOCKS_bm_requestable_workers);
return;
}
extern int vsc_op;
static inline
void SCH_update_local_or_tops(void) {
LOCAL_top_cp = LOCAL_top_cp->cp_b;
LOCAL_top_or_fr = LOCAL_top_cp->cp_or_fr;
return;
}
static inline
void SCH_refuse_share_request_if_any(void) {
if (SCH_any_share_request) {
REMOTE_reply_signal(LOCAL_share_request) = no_sharing;
LOCAL_share_request = MAX_WORKERS;
PUT_OUT_REQUESTABLE(worker_id);
}
return;
}
static inline
void SCH_set_load(choiceptr current_cp) {
int lub; /* local untried branches */
choiceptr previous_cp = current_cp->cp_b;
#define INIT_CP_LUB(CP, LUB) CP->cp_or_fr = (struct or_frame *)(LUB)
#define CP_LUB(CP) (int)(CP->cp_or_fr)
if (SCH_top_shared_cp(previous_cp))
lub = 0;
else if (YAMOP_SEQ(previous_cp->cp_ap))
lub = CP_LUB(previous_cp);
else
lub = CP_LUB(previous_cp) + YAMOP_LTT(previous_cp->cp_ap);
INIT_CP_LUB(current_cp, lub);
if (YAMOP_SEQ(current_cp->cp_ap))
LOCAL_load = lub;
else
LOCAL_load = lub + YAMOP_LTT(current_cp->cp_ap);
return;
}
static inline
void SCH_new_alternative(yamop *curpc, yamop *new) {
OrFr_alternative(LOCAL_top_or_fr) = new;
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = YAMOP_OR_ARG(curpc);
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return;
}
/* ---------------------------- **
** Cut Stuff: Pruning **
** ---------------------------- */
static inline
void CUT_prune_to(choiceptr prune_cp) {
if (EQUAL_OR_YOUNGER_CP(prune_cp, LOCAL_top_cp)) {
B = prune_cp;
} else {
if (! LOCAL_prune_request)
prune_shared_branch(prune_cp);
B = LOCAL_top_cp;
}
return;
}
static inline
void CUT_send_prune_request(int worker, choiceptr prune_cp) {
LOCK_WORKER(worker);
if (YOUNGER_CP(REMOTE_top_cp(worker), prune_cp) &&
(! REMOTE_prune_request(worker) || YOUNGER_CP(REMOTE_prune_request(worker), prune_cp)))
REMOTE_prune_request(worker) = prune_cp;
UNLOCK_WORKER(worker);
return;
}
static inline
void CUT_reset_prune_request(void) {
LOCK_WORKER(worker_id);
if (LOCAL_prune_request && EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp))
LOCAL_prune_request = NULL;
UNLOCK_WORKER(worker_id);
return;
}
/* ----------------------------- **
** Cut Stuff: Leftmost **
** ----------------------------- */
static inline
int CUT_last_worker_left_pending_prune(or_fr_ptr or_frame) {
int i, depth, ltt;
bitmap members;
depth = OrFr_depth(or_frame);
ltt = OrFr_pend_prune_ltt(or_frame);
members = OrFr_members(or_frame);
BITMAP_delete(members, worker_id);
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(members, i) && BRANCH_LTT(i, depth) > ltt)
return FALSE;
}
return TRUE;
}
static inline
or_fr_ptr CUT_leftmost_or_frame(void) {
int i, depth, ltt;
bitmap members;
or_fr_ptr leftmost_or_fr, or_fr, nearest_or_fr;
BITMAP_clear(members);
BITMAP_insert(members, worker_id);
leftmost_or_fr = LOCAL_top_or_fr;
depth = OrFr_depth(leftmost_or_fr);
do {
ltt = BRANCH_LTT(worker_id, depth);
BITMAP_difference(members, OrFr_members(leftmost_or_fr), members);
if (members)
for (i = 0; i < number_workers; i++)
if (BITMAP_member(members, i) && BRANCH_LTT(i, depth) > ltt)
goto update_nearest_leftnode_data;
BITMAP_copy(members, OrFr_members(leftmost_or_fr));
leftmost_or_fr = OrFr_nearest_leftnode(leftmost_or_fr);
depth = OrFr_depth(leftmost_or_fr);
} while (depth);
update_nearest_leftnode_data:
or_fr = LOCAL_top_or_fr;
nearest_or_fr = OrFr_nearest_leftnode(or_fr);
while (OrFr_depth(nearest_or_fr) > depth) {
LOCK_OR_FRAME(or_fr);
OrFr_nearest_leftnode(or_fr) = leftmost_or_fr;
UNLOCK_OR_FRAME(or_fr);
or_fr = nearest_or_fr;
nearest_or_fr = OrFr_nearest_leftnode(or_fr);
}
return leftmost_or_fr;
}
#ifdef TABLING_INNER_CUTS
static inline
or_fr_ptr CUT_leftmost_until(or_fr_ptr start_or_fr, int until_depth) {
int i, ltt, depth;
bitmap prune_members, members;
or_fr_ptr leftmost_or_fr, nearest_or_fr;
/* we assume that the start_or_fr frame is locked and empty (without members) */
leftmost_or_fr = OrFr_nearest_leftnode(start_or_fr);
depth = OrFr_depth(leftmost_or_fr);
if (depth > until_depth) {
BITMAP_copy(prune_members, GLOBAL_bm_pruning_workers);
BITMAP_delete(prune_members, worker_id);
ltt = BRANCH_LTT(worker_id, depth);
BITMAP_intersection(members, prune_members, OrFr_members(leftmost_or_fr));
if (members) {
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(members, i) &&
BRANCH_LTT(i, depth) > ltt &&
EQUAL_OR_YOUNGER_CP(OrFr_node(leftmost_or_fr), REMOTE_pruning_scope(i)))
return leftmost_or_fr;
}
BITMAP_minus(prune_members, members);
}
/* reaching that point we should update the nearest leftnode data before return */
leftmost_or_fr = OrFr_nearest_leftnode(leftmost_or_fr);
depth = OrFr_depth(leftmost_or_fr);
while (depth > until_depth) {
ltt = BRANCH_LTT(worker_id, depth);
BITMAP_intersection(members, prune_members, OrFr_members(leftmost_or_fr));
if (members) {
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(members, i) &&
BRANCH_LTT(i, depth) > ltt &&
EQUAL_OR_YOUNGER_CP(OrFr_node(leftmost_or_fr), REMOTE_pruning_scope(i))) {
/* update nearest leftnode data */
OrFr_nearest_leftnode(start_or_fr) = leftmost_or_fr;
start_or_fr = OrFr_nearest_leftnode(start_or_fr);
nearest_or_fr = OrFr_nearest_leftnode(start_or_fr);
while (OrFr_depth(nearest_or_fr) > depth) {
LOCK_OR_FRAME(start_or_fr);
OrFr_nearest_leftnode(start_or_fr) = leftmost_or_fr;
UNLOCK_OR_FRAME(start_or_fr);
start_or_fr = nearest_or_fr;
nearest_or_fr = OrFr_nearest_leftnode(start_or_fr);
}
return leftmost_or_fr;
}
}
BITMAP_minus(prune_members, members);
}
leftmost_or_fr = OrFr_nearest_leftnode(leftmost_or_fr);
depth = OrFr_depth(leftmost_or_fr);
}
/* update nearest leftnode data */
OrFr_nearest_leftnode(start_or_fr) = leftmost_or_fr;
start_or_fr = OrFr_nearest_leftnode(start_or_fr);
nearest_or_fr = OrFr_nearest_leftnode(start_or_fr);
while (OrFr_depth(nearest_or_fr) > depth) {
LOCK_OR_FRAME(start_or_fr);
OrFr_nearest_leftnode(start_or_fr) = leftmost_or_fr;
UNLOCK_OR_FRAME(start_or_fr);
start_or_fr = nearest_or_fr;
nearest_or_fr = OrFr_nearest_leftnode(start_or_fr);
}
}
return NULL;
}
#endif /* TABLING_INNER_CUTS */
/* ------------------------------------------------ **
** Cut Stuff: Managing query goal answers **
** ------------------------------------------------ */
static inline
void CUT_store_answer(or_fr_ptr or_frame, qg_ans_fr_ptr new_answer) {
int ltt;
qg_sol_fr_ptr *solution_ptr;
ltt = BRANCH_LTT(worker_id, OrFr_depth(or_frame));
solution_ptr = & OrFr_qg_solutions(or_frame);
while (*solution_ptr && ltt > SolFr_ltt(*solution_ptr)) {
solution_ptr = & SolFr_next(*solution_ptr);
}
if (*solution_ptr && ltt == SolFr_ltt(*solution_ptr)) {
AnsFr_next(SolFr_last(*solution_ptr)) = new_answer;
SolFr_last(*solution_ptr) = new_answer;
} else {
qg_sol_fr_ptr new_solution;
ALLOC_QG_SOLUTION_FRAME(new_solution);
SolFr_next(new_solution) = *solution_ptr;
SolFr_ltt(new_solution) = ltt;
SolFr_first(new_solution) = new_answer;
SolFr_last(new_solution) = new_answer;
*solution_ptr = new_solution;
}
return;
}
static inline
void CUT_store_answers(or_fr_ptr or_frame, qg_sol_fr_ptr new_solution) {
int ltt;
qg_sol_fr_ptr *solution_ptr;
ltt = BRANCH_LTT(worker_id, OrFr_depth(or_frame));
solution_ptr = & OrFr_qg_solutions(or_frame);
while (*solution_ptr && ltt > SolFr_ltt(*solution_ptr)) {
solution_ptr = & SolFr_next(*solution_ptr);
}
if (*solution_ptr && ltt == SolFr_ltt(*solution_ptr)) {
AnsFr_next(SolFr_last(*solution_ptr)) = SolFr_first(new_solution);
SolFr_last(*solution_ptr) = SolFr_last(new_solution);
FREE_QG_SOLUTION_FRAME(new_solution);
} else {
SolFr_next(new_solution) = *solution_ptr;
SolFr_ltt(new_solution) = ltt;
*solution_ptr = new_solution;
}
return;
}
static inline
void CUT_join_answers_in_an_unique_frame(qg_sol_fr_ptr join_solution) {
qg_sol_fr_ptr next_solution;
while ((next_solution = SolFr_next(join_solution))) {
AnsFr_next(SolFr_last(join_solution)) = SolFr_first(next_solution);
SolFr_last(join_solution) = SolFr_last(next_solution);
SolFr_next(join_solution) = SolFr_next(next_solution);
FREE_QG_SOLUTION_FRAME(next_solution);
}
return;
}
static inline
void CUT_free_solution_frame(qg_sol_fr_ptr solution) {
qg_ans_fr_ptr current_answer, next_answer;
current_answer = SolFr_first(solution);
do {
next_answer = AnsFr_next(current_answer);
FREE_QG_ANSWER_FRAME(current_answer);
current_answer = next_answer;
} while (current_answer);
FREE_QG_SOLUTION_FRAME(solution);
return;
}
static inline
void CUT_free_solution_frames(qg_sol_fr_ptr current_solution) {
qg_sol_fr_ptr next_solution;
while (current_solution) {
next_solution = SolFr_next(current_solution);
CUT_free_solution_frame(current_solution);
current_solution = next_solution;
}
return;
}
static inline
qg_sol_fr_ptr CUT_prune_solution_frames(qg_sol_fr_ptr solutions, int ltt) {
qg_sol_fr_ptr next_solution;
while (solutions && ltt > SolFr_ltt(solutions)) {
next_solution = SolFr_next(solutions);
CUT_free_solution_frame(solutions);
solutions = next_solution;
}
return solutions;
}

332
OPTYap/or.sbaengine.c Normal file
View File

@@ -0,0 +1,332 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#ifdef SBA
#include "Yatom.h"
#include "Heap.h"
#include "or.macros.h"
#include <stdio.h>
#include "opt.mavar.h"
/* ------------------------------------- **
** Local functions declaration **
** ------------------------------------- */
static void share_private_nodes(int worker_q);
static void
reset_trail(tr_fr_ptr tr_top, tr_fr_ptr trp)
{
register CELL aux_cell;
/* unbinding variables */
while (tr_top != trp) {
aux_cell = TrailTerm(--trp);
/* check for global or local variables */
if (IsVarTerm(aux_cell)) {
/* clean up the trail when we backtrack */
/* shouldn't this test always succeed? */
if (Unsigned((Int)(aux_cell)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(aux_cell));
} else {
RESET_VARIABLE(aux_cell);
}
}
else if (IsPairTerm(aux_cell)) {
/* avoid frozen segments */
if ((ADDR) RepPair(aux_cell) > HeapTop) {
trp = (tr_fr_ptr) RepPair(aux_cell);
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
CELL *aux_ptr = RepAppl(aux_cell);
trp--;
if (Unsigned((Int)(aux_ptr)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
*STACK_TO_SBA(aux_ptr) = TrailTerm(trp);
} else {
*aux_ptr = TrailTerm(trp);
}
#endif
}
}
}
/* ---------------------- **
** Local macros **
** ---------------------- */
#define COMPUTE_SEGMENTS_TO_COPY_TO(Q) \
REMOTE_end_local_copy(Q) = (CELL) (REMOTE_top_cp(Q)); \
REMOTE_start_local_copy(Q) = (CELL) (B)
/* -------------------------- **
** Global functions **
** -------------------------- */
void make_root_choice_point(void) {
if (worker_id == 0) {
LOCAL_top_cp = GLOBAL_root_cp = OrFr_node(GLOBAL_root_or_fr) = B;
B->cp_h = H0;
B->cp_ap = GETWORK;
B->cp_or_fr = GLOBAL_root_or_fr;
} else {
B = LOCAL_top_cp = GLOBAL_root_cp;
TR = B->cp_tr;
}
LOCAL_top_or_fr = GLOBAL_root_or_fr;
LOCAL_load = 0;
LOCAL_prune_request = NULL;
BRANCH(worker_id, 0) = 0;
H_FZ = H_BASE;
B_FZ = B_BASE;
TR_FZ = TR_BASE;
}
void free_root_choice_point(void) {
reset_trail(LOCAL_top_cp->cp_tr, TR);
TR = LOCAL_top_cp->cp_tr;
B = LOCAL_top_cp->cp_b;
LOCAL_top_cp = B_BASE;
H_FZ = H_BASE;
B_FZ = B_BASE;
TR_FZ = TR_BASE;
}
void p_share_work(void) {
int worker_q = LOCAL_share_request;
if (! BITMAP_member(OrFr_members(REMOTE_top_or_fr(worker_q)), worker_id) ||
B == REMOTE_top_cp(worker_q) ||
(LOCAL_load <= DELAYED_RELEASE_LOAD && OrFr_nearest_livenode(LOCAL_top_or_fr) == NULL)) {
/* refuse sharing request */
REMOTE_reply_signal(LOCAL_share_request) = no_sharing;
LOCAL_share_request = MAX_WORKERS;
PUT_OUT_REQUESTABLE(worker_id);
return;
}
/* sharing request accepted */
/* LOCAL_reply_signal = sharing; */
COMPUTE_SEGMENTS_TO_COPY_TO(worker_q);
share_private_nodes(worker_q);
REMOTE_reply_signal(worker_q) = sharing;
/* REMOTE_reply_signal(worker_q) = nodes_shared; */
/* while (LOCAL_reply_signal == sharing); */
LOCAL_share_request = MAX_WORKERS;
PUT_IN_REQUESTABLE(worker_id);
return;
}
int q_share_work(int worker_p) {
register tr_fr_ptr aux_tr;
register CELL aux_cell;
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (REMOTE_prune_request(worker_p)) {
/* worker p with prune request */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
#ifdef YAPOR_ERRORS
if (OrFr_pend_prune_cp(LOCAL_top_or_fr) &&
BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr))
YAPOR_ERROR_MESSAGE("prune ltt > worker_p branch ltt (q_share_work)");
#endif /* YAPOR_ERRORS */
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
LOCAL_prune_request = NULL;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
reset_trail(LOCAL_top_cp->cp_tr, TR);
TR = LOCAL_top_cp->cp_tr;
/* make sharing request */
LOCK_WORKER(worker_p);
if (BITMAP_member(GLOBAL_bm_idle_workers, worker_p) ||
REMOTE_share_request(worker_p) != MAX_WORKERS) {
/* worker p is idle or has another request */
UNLOCK_WORKER(worker_p);
return FALSE;
}
REMOTE_share_request(worker_p) = worker_id;
UNLOCK_WORKER(worker_p);
/* wait for an answer */
while (LOCAL_reply_signal == ready);
if (LOCAL_reply_signal == no_sharing) {
/* sharing request refused */
LOCAL_reply_signal = ready;
return FALSE;
}
/* install fase --> TR and LOCAL_top_cp->cp_tr are equal */
TR = ((choiceptr)LOCAL_end_local_copy)->cp_tr;
aux_tr = ((choiceptr) LOCAL_start_local_copy)->cp_tr;
NEW_MAHASH((ma_h_inner_struct *)H);
while (TR != aux_tr) {
aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) {
CELL *ptr = STACK_TO_SBA(aux_cell);
*ptr = TrailVal(aux_tr);
} else if ((ADDR) RepPair(aux_cell) >= HeapTop) {
/* avoid frozen segments */
aux_tr = (tr_fr_ptr) RepPair(aux_cell);
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else if (IsApplTerm(aux_cell)) {
CELL *cell_ptr = RepAppl(aux_cell);
if (!lookup_ma_var(cell_ptr)) {
/* first time we found the variable, let's put the new value */
CELL *ptr = STACK_TO_SBA(cell_ptr);
*ptr = TrailVal(aux_tr);
}
/* skip the old value */
aux_tr--;
}
#endif
}
/* update registers and return */
/* REMOTE_reply_signal(worker_p) = ready; */
LOCAL_reply_signal = ready;
PUT_IN_REQUESTABLE(worker_id);
TR = LOCAL_top_cp->cp_tr;
return TRUE;
}
/* ------------------------- **
** Local functions **
** ------------------------- */
static
void share_private_nodes(int worker_q) {
int depth;
choiceptr AuxB;
or_fr_ptr or_frame, previous_or_frame;
/* initialize auxiliary variables */
AuxB = B;
previous_or_frame = NULL;
depth = OrFr_depth(LOCAL_top_or_fr);
/* sharing loop */
while (AuxB != LOCAL_top_cp) {
depth++;
ALLOC_OR_FRAME(or_frame);
INIT_LOCK(OrFr_lock(or_frame));
OrFr_node(or_frame) = AuxB;
OrFr_alternative(or_frame) = AuxB->cp_ap;
OrFr_pend_prune_cp(or_frame) = NULL;
OrFr_nearest_leftnode(or_frame) = LOCAL_top_or_fr;
OrFr_qg_solutions(or_frame) = NULL;
BITMAP_clear(OrFr_members(or_frame));
BITMAP_insert(OrFr_members(or_frame), worker_id);
BITMAP_insert(OrFr_members(or_frame), worker_q);
if (AuxB->cp_ap && YAMOP_SEQ(AuxB->cp_ap)) {
AuxB->cp_ap = GETWORK_SEQ;
} else {
AuxB->cp_ap = GETWORK;
}
AuxB->cp_or_fr = or_frame;
AuxB = AuxB->cp_b;
if (previous_or_frame) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
previous_or_frame = or_frame;
}
/* initialize last or-frame pointer */
or_frame = AuxB->cp_or_fr;
if (previous_or_frame) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
/* update depth */
if (depth >= MAX_DEPTH)
abort_optyap("maximum depth exceded (%d/%d) (share_private_nodes)", MAX_DEPTH, depth - MAX_DEPTH);
or_frame = B->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) {
unsigned int branch;
if (OrFr_alternative(or_frame)) {
branch = YAMOP_OR_ARG(OrFr_alternative(or_frame)) + 1;
} else {
branch = 1;
}
branch |= YAMOP_CUT_FLAG; /* in doubt, assume cut */
BRANCH(worker_id, depth) = BRANCH(worker_q, depth) = branch;
OrFr_depth(or_frame) = depth--;
or_frame = OrFr_next_on_stack(or_frame);
}
/* update old shared nodes */
while (or_frame != REMOTE_top_or_fr(worker_q)) {
LOCK_OR_FRAME(or_frame);
BRANCH(worker_q, OrFr_depth(or_frame)) = BRANCH(worker_id, OrFr_depth(or_frame));
BITMAP_insert(OrFr_members(or_frame), worker_q);
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
}
/* move conditional bindings to BA */
{
tr_fr_ptr top, tr_ptr;
top = LOCAL_top_cp->cp_tr;
tr_ptr = TR;
while (tr_ptr != top) {
CELL aux_cell = TrailTerm(--tr_ptr);
if (IsVarTerm(aux_cell) &&
((CELL *)aux_cell < B->cp_h || (choiceptr)aux_cell > B) &&
!((CELL *)aux_cell < H_FZ || (choiceptr)aux_cell > B_FZ)) {
CELL *ptr = STACK_TO_SBA(aux_cell);
*ptr = TrailVal(tr_ptr);
*(CELL *)aux_cell = (CELL)ptr;
} else if (IsPairTerm(aux_cell) && (ADDR) RepPair(aux_cell) > HeapTop) {
/* avoid frozen segments */
aux_cell = (CELL) RepPair(aux_cell);
tr_ptr = (tr_fr_ptr) aux_cell;
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
CELL *cell_ptr = RepAppl(aux_cell);
/* first do as a for a standard cell */
if ((cell_ptr < B->cp_h || cell_ptr > (CELL *)B) && !(cell_ptr < H_FZ || (choiceptr)cell_ptr > B_FZ)) {
CELL *ptr = STACK_TO_SBA(cell_ptr);
/* we may have several bindings in the trail */
if ((CELL)ptr != *cell_ptr) {
*ptr = TrailVal(tr_ptr);
*cell_ptr = (CELL)ptr;
}
}
/* but we also need to skip the old value */
tr_ptr--;
#endif
}
}
}
/* update frozen registers */
B_FZ = B;
H_FZ = B->cp_h;
TR_FZ = B->cp_tr;
/* update top shared nodes */
REMOTE_top_cp(worker_q) = LOCAL_top_cp = B;
REMOTE_top_or_fr(worker_q) = LOCAL_top_or_fr = LOCAL_top_cp->cp_or_fr;
/* update prune request */
if (LOCAL_prune_request) {
CUT_send_prune_request(worker_q, LOCAL_prune_request);
}
/* update load and return */
REMOTE_load(worker_q) = LOCAL_load = 0;
}
#endif /* SBA */

662
OPTYap/or.scheduler.c Normal file
View File

@@ -0,0 +1,662 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#ifdef YAPOR
#include "Yatom.h"
#include "Heap.h"
#include "or.macros.h"
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
/* ------------------------------------- **
** Local functions declaration **
** ------------------------------------- */
static int move_up_one_node(or_fr_ptr nearest_livenode);
static int get_work_below(void);
static int get_work_above(void);
static int find_a_better_position(void);
static int search_for_hidden_shared_work(bitmap stable_busy);
/* ----------------------- **
** Local inlines **
** ----------------------- */
STD_PROTO(static inline void PUT_NO_WORK_IN_UPPER_NODES, (void));
STD_PROTO(static inline void PUT_IDLE, (int));
STD_PROTO(static inline void PUT_BUSY, (int));
STD_PROTO(static inline void PUT_IN_ROOT_NODE, (int));
STD_PROTO(static inline void PUT_OUT_ROOT_NODE, (int));
STD_PROTO(static inline void move_up_to_prune_request, (void));
static inline
void PUT_NO_WORK_IN_UPPER_NODES(void) {
or_fr_ptr current_node, nearest_livenode;
current_node = LOCAL_top_or_fr;
while ((nearest_livenode = OrFr_nearest_livenode(current_node))) {
OrFr_nearest_livenode(current_node) = NULL;
current_node = nearest_livenode;
}
return;
}
static inline
void PUT_IDLE(int worker_num) {
LOCK(GLOBAL_LOCKS_bm_idle_workers);
BITMAP_insert(GLOBAL_bm_idle_workers, worker_num);
UNLOCK(GLOBAL_LOCKS_bm_idle_workers);
return;
}
static inline
void PUT_BUSY(int worker_num) {
LOCK(GLOBAL_LOCKS_bm_idle_workers);
BITMAP_delete(GLOBAL_bm_idle_workers, worker_num);
UNLOCK(GLOBAL_LOCKS_bm_idle_workers);
return;
}
static inline
void PUT_IN_ROOT_NODE(int worker_num) {
LOCK(GLOBAL_LOCKS_bm_root_cp_workers);
BITMAP_insert(GLOBAL_bm_root_cp_workers, worker_num);
UNLOCK(GLOBAL_LOCKS_bm_root_cp_workers);
return;
}
static inline
void PUT_OUT_ROOT_NODE(int worker_num) {
LOCK(GLOBAL_LOCKS_bm_root_cp_workers);
BITMAP_delete(GLOBAL_bm_root_cp_workers, worker_num);
UNLOCK(GLOBAL_LOCKS_bm_root_cp_workers);
return;
}
static inline
void move_up_to_prune_request(void) {
#ifdef YAPOR_ERRORS
if (EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp))
YAPOR_ERROR_MESSAGE("invalid LOCAL_prune_request (move_up_to_prune_request)");
#endif /* YAPOR_ERRORS */
do {
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (BITMAP_alone(OrFr_members(LOCAL_top_or_fr), worker_id)) {
#ifdef TABLING
if (OrFr_suspensions(LOCAL_top_or_fr) || OrFr_owners(LOCAL_top_or_fr) != 1)
pruning_over_tabling_data_structures();
#endif /* TABLING */
CUT_free_solution_frames(OrFr_qg_solutions(LOCAL_top_or_fr));
#ifdef TABLING_INNER_CUTS
CUT_free_tg_solution_frames(OrFr_tg_solutions(LOCAL_top_or_fr));
#endif /* TABLING_INNER_CUTS */
FREE_OR_FRAME(LOCAL_top_or_fr);
} else {
BITMAP_delete(OrFr_members(LOCAL_top_or_fr), worker_id);
#ifdef TABLING
OrFr_owners(LOCAL_top_or_fr)--;
#endif /* TABLING */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
}
SCH_update_local_or_tops();
} while (LOCAL_top_cp != LOCAL_prune_request);
CUT_reset_prune_request();
#ifdef TABLING
LOCAL_top_cp_on_stack = LOCAL_top_cp;
abolish_incomplete_subgoals(LOCAL_top_cp);
#endif /* TABLIG */
return;
}
/* -------------------------- **
** Global functions **
** -------------------------- */
int get_work(void) {
int counter;
bitmap stable_busy;
yamop *alt_with_work;
or_fr_ptr or_fr_with_work, or_fr_to_move_to;
#ifdef TABLING
choiceptr leader_node = DepFr_leader_cp(LOCAL_top_dep_fr);
#endif /* TABLING */
/* reset local load */
LOCAL_load = 0;
/* check for prune request */
if (LOCAL_prune_request)
move_up_to_prune_request();
/* find nearest node with available work */
or_fr_with_work = LOCAL_top_or_fr;
do {
or_fr_with_work = OrFr_nearest_livenode(or_fr_with_work);
if (or_fr_with_work == NULL)
break;
alt_with_work = OrFr_alternative(or_fr_with_work);
} while (alt_with_work == NULL || YAMOP_SEQ(alt_with_work));
#ifndef TABLING
/* wait for incomplete installations */
while (LOCAL_reply_signal != ready);
#endif /* TABLING */
if (or_fr_with_work) {
/* move up to the nearest node with available work */
#ifdef TABLING
if (leader_node && YOUNGER_CP(leader_node, OrFr_node(or_fr_with_work)))
/* there is a leader node before the nearest node with work */
or_fr_to_move_to = leader_node->cp_or_fr;
else
#endif /* TABLING */
or_fr_to_move_to = or_fr_with_work;
do {
if (! move_up_one_node(or_fr_with_work))
break;
} while (LOCAL_top_or_fr != or_fr_to_move_to);
return TRUE;
}
/* no nodes with available work */
PUT_NO_WORK_IN_UPPER_NODES();
#ifdef TABLING
if (leader_node) {
/* there is a leader node */
or_fr_to_move_to = leader_node->cp_or_fr;;
do {
if (! move_up_one_node(NULL))
break;
} while (LOCAL_top_or_fr != or_fr_to_move_to);
return TRUE;
}
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
if (LOCAL_pruning_scope) {
PUT_OUT_PRUNING(worker_id);
LOCAL_pruning_scope = NULL;
}
#endif /* TABLING_INNER_CUTS */
PUT_OUT_ROOT_NODE(worker_id);
LOCK_WORKER(worker_id);
PUT_IDLE(worker_id);
UNLOCK_WORKER(worker_id);
SCH_refuse_share_request_if_any();
counter = 0;
BITMAP_difference(stable_busy, OrFr_members(LOCAL_top_or_fr), GLOBAL_bm_idle_workers);
while (1) {
while (BITMAP_subset(GLOBAL_bm_idle_workers, OrFr_members(LOCAL_top_or_fr)) &&
LOCAL_top_cp != GLOBAL_root_cp) {
/* no busy workers here and below */
if (! move_up_one_node(NULL)) {
PUT_BUSY(worker_id);
return TRUE;
}
}
if (LOCAL_top_cp == GLOBAL_root_cp) {
PUT_IN_ROOT_NODE(worker_id);
if (BITMAP_same(GLOBAL_bm_idle_workers, GLOBAL_bm_root_cp_workers) &&
BITMAP_same(GLOBAL_bm_idle_workers, GLOBAL_bm_present_workers)) {
/* All workers are idle in root choicepoint. Execution
must finish as there is no available computation. */
return FALSE;
}
}
if (get_work_below()) {
PUT_BUSY(worker_id);
return TRUE;
}
if (get_work_above()) {
PUT_BUSY(worker_id);
return TRUE;
}
if (find_a_better_position()) {
PUT_BUSY(worker_id);
return TRUE;
}
if (++counter == SCHEDULER_LOOP) {
if (search_for_hidden_shared_work(stable_busy)) {
PUT_BUSY(worker_id);
return TRUE;
}
counter = 0;
BITMAP_difference(stable_busy, OrFr_members(LOCAL_top_or_fr), GLOBAL_bm_idle_workers);
} else {
BITMAP_minus(stable_busy, GLOBAL_bm_idle_workers);
}
}
}
/* ------------------------- **
** Local functions **
** ------------------------- */
static
int move_up_one_node(or_fr_ptr nearest_livenode) {
#ifdef YAPOR_ERRORS
if (LOCAL_prune_request && EQUAL_OR_YOUNGER_CP(LOCAL_prune_request, LOCAL_top_cp))
YAPOR_ERROR_MESSAGE("invalid LOCAL_prune_request (move_up_one_node)");
#endif /* YAPOR_ERRORS */
LOCK_OR_FRAME(LOCAL_top_or_fr);
/* last worker in a sequential choicepoint ? */
if (OrFr_alternative(LOCAL_top_or_fr)
&& YAMOP_SEQ(OrFr_alternative(LOCAL_top_or_fr))
&& BITMAP_alone(OrFr_members(LOCAL_top_or_fr), worker_id)) {
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
/* pending prune ? */
if (OrFr_pend_prune_cp(LOCAL_top_or_fr)
&& ! LOCAL_prune_request
&& CUT_last_worker_left_pending_prune(LOCAL_top_or_fr)) {
choiceptr prune_cp = OrFr_pend_prune_cp(LOCAL_top_or_fr);
OrFr_pend_prune_cp(LOCAL_top_or_fr) = NULL;
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = OrFr_pend_prune_ltt(LOCAL_top_or_fr);
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
prune_shared_branch(prune_cp);
#ifdef TABLING
abolish_incomplete_subgoals(LOCAL_top_cp);
#endif /* TABLIG */
return FALSE;
}
#ifdef OPTYAP_ERRORS
if (B_FZ != DepFr_cons_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("B_FZ != DepFr_cons_cp(LOCAL_top_dep_fr) (move_up_one_node)");
if (LOCAL_top_susp_or_fr) {
if (EQUAL_OR_YOUNGER_CP(LOCAL_top_cp, B_FZ) && YOUNGER_CP(OrFr_node(LOCAL_top_susp_or_fr), LOCAL_top_cp))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(OrFr_node(LOCAL_top_susp_or_fr), LOCAL_top_cp) (move_up_one_node)");
if (YOUNGER_CP(B_FZ, LOCAL_top_cp) && YOUNGER_CP(OrFr_node(LOCAL_top_susp_or_fr), B_FZ))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(OrFr_node(LOCAL_top_susp_or_fr), B_FZ) (move_up_one_node)");
}
#endif /* OPTYAP_ERRORS */
#ifdef TABLING
/* frozen stacks on branch ? */
if (YOUNGER_CP(B_FZ, LOCAL_top_cp)) {
if (nearest_livenode)
OrFr_nearest_livenode(LOCAL_top_or_fr) = nearest_livenode;
BITMAP_delete(OrFr_members(LOCAL_top_or_fr), worker_id);
if (BITMAP_empty(OrFr_members(LOCAL_top_or_fr))) {
if (frame_with_suspensions_not_collected(LOCAL_top_or_fr)) {
collect_suspension_frames(LOCAL_top_or_fr);
}
#ifdef TABLING_INNER_CUTS
if (OrFr_tg_solutions(LOCAL_top_or_fr)) {
tg_sol_fr_ptr tg_solutions;
or_fr_ptr leftmost_until;
tg_solutions = OrFr_tg_solutions(LOCAL_top_or_fr);
leftmost_until = CUT_leftmost_until(LOCAL_top_or_fr, OrFr_depth(TgSolFr_gen_cp(tg_solutions)->cp_or_fr));
OrFr_tg_solutions(LOCAL_top_or_fr) = NULL;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
if (leftmost_until) {
LOCK_OR_FRAME(leftmost_until);
tg_solutions = CUT_store_tg_answers(leftmost_until, tg_solutions,
BRANCH_LTT(worker_id, OrFr_depth(leftmost_until)));
UNLOCK_OR_FRAME(leftmost_until);
}
CUT_validate_tg_answers(tg_solutions);
goto update_local_tops1;
}
#endif /* TABLING_INNER_CUTS */
}
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
#ifdef TABLING_INNER_CUTS
update_local_tops1:
#endif /* TABLING_INNER_CUTS */
SCH_update_local_or_tops();
if (LOCAL_prune_request)
pruning_over_tabling_data_structures();
return TRUE;
}
/* suspension frames to resume ? */
if (OrFr_suspensions(LOCAL_top_or_fr)) {
susp_fr_ptr resume_fr;
#ifdef TIMESTAMP_CHECK
resume_fr = suspension_frame_to_resume(LOCAL_top_or_fr, ++GLOBAL_timestamp);
#else
resume_fr = suspension_frame_to_resume(LOCAL_top_or_fr);
#endif /* TIMESTAMP_CHECK */
if (resume_fr) {
if (LOCAL_top_susp_or_fr == LOCAL_top_or_fr && OrFr_suspensions(LOCAL_top_or_fr) == NULL) {
LOCAL_top_susp_or_fr = OrFr_nearest_suspnode(LOCAL_top_or_fr);
OrFr_nearest_suspnode(LOCAL_top_or_fr) = LOCAL_top_or_fr;
}
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
unbind_variables(TR, LOCAL_top_cp->cp_tr);
resume_suspension_frame(resume_fr, LOCAL_top_or_fr);
return FALSE;
}
if (LOCAL_top_susp_or_fr == LOCAL_top_or_fr) {
LOCAL_top_susp_or_fr = OrFr_nearest_suspnode(LOCAL_top_or_fr);
OrFr_nearest_suspnode(LOCAL_top_or_fr) = NULL;
}
} else if (LOCAL_top_susp_or_fr == LOCAL_top_or_fr) {
LOCAL_top_susp_or_fr = OrFr_nearest_suspnode(LOCAL_top_or_fr);
OrFr_nearest_suspnode(LOCAL_top_or_fr) = LOCAL_top_or_fr;
}
/* top node frozen ? */
if (B_FZ == LOCAL_top_cp) {
if (nearest_livenode)
OrFr_nearest_livenode(LOCAL_top_or_fr) = nearest_livenode;
BITMAP_delete(OrFr_members(LOCAL_top_or_fr), worker_id);
#ifdef TABLING_INNER_CUTS
if (BITMAP_empty(OrFr_members(LOCAL_top_or_fr))) {
#endif /* TABLING_INNER_CUTS */
if (OrFr_suspensions(LOCAL_top_or_fr) && OrFr_owners(LOCAL_top_or_fr) == 1) {
complete_suspension_frames(LOCAL_top_or_fr);
}
#ifdef TABLING_INNER_CUTS
if (OrFr_tg_solutions(LOCAL_top_or_fr)) {
tg_sol_fr_ptr tg_solutions;
or_fr_ptr leftmost_until;
tg_solutions = OrFr_tg_solutions(LOCAL_top_or_fr);
leftmost_until = CUT_leftmost_until(LOCAL_top_or_fr, OrFr_depth(TgSolFr_gen_cp(tg_solutions)->cp_or_fr));
OrFr_tg_solutions(LOCAL_top_or_fr) = NULL;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
if (leftmost_until) {
LOCK_OR_FRAME(leftmost_until);
tg_solutions = CUT_store_tg_answers(leftmost_until, tg_solutions,
BRANCH_LTT(worker_id, OrFr_depth(leftmost_until)));
UNLOCK_OR_FRAME(leftmost_until);
}
CUT_validate_tg_answers(tg_solutions);
goto update_local_tops2;
}
}
#endif /* TABLING_INNER_CUTS */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
#ifdef TABLING_INNER_CUTS
update_local_tops2:
#endif /* TABLING_INNER_CUTS */
SCH_update_local_or_tops();
if (LOCAL_prune_request)
pruning_over_tabling_data_structures();
return TRUE;
}
#ifdef OPTYAP_ERRORS
if (OrFr_alternative(LOCAL_top_or_fr) && ! YAMOP_SEQ(OrFr_alternative(LOCAL_top_or_fr)))
OPTYAP_ERROR_MESSAGE("OrFr_alternative(LOCAL_top_or_fr) not sequential (move_up_one_node)");
if (LOCAL_top_cp == DepFr_cons_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp == DepFr_cons_cp(LOCAL_top_dep_fr) (move_up_one_node)");
if (LOCAL_top_cp != LOCAL_top_cp_on_stack)
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp != LOCAL_top_cp_on_stack (move_up_one_node)");
#endif /* OPTYAP_ERRORS */
/* no frozen nodes */
LOCAL_top_cp_on_stack = OrFr_node(OrFr_next_on_stack(LOCAL_top_or_fr));
/* no more owners ? */
if (OrFr_owners(LOCAL_top_or_fr) == 1) {
if (OrFr_suspensions(LOCAL_top_or_fr)) {
complete_suspension_frames(LOCAL_top_or_fr);
}
if (LOCAL_top_sg_fr && LOCAL_top_cp == SgFr_gen_cp(LOCAL_top_sg_fr)) {
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
#else
/* last member worker in node ? */
if (BITMAP_alone(OrFr_members(LOCAL_top_or_fr), worker_id)) {
#endif /* TABLING */
if (LOCAL_prune_request) {
CUT_free_solution_frames(OrFr_qg_solutions(LOCAL_top_or_fr));
#ifdef TABLING_INNER_CUTS
CUT_free_tg_solution_frames(OrFr_tg_solutions(LOCAL_top_or_fr));
#endif /* TABLING_INNER_CUTS */
FREE_OR_FRAME(LOCAL_top_or_fr);
SCH_update_local_or_tops();
CUT_reset_prune_request();
} else {
qg_sol_fr_ptr qg_solutions = OrFr_qg_solutions(LOCAL_top_or_fr);
#ifdef TABLING_INNER_CUTS
tg_sol_fr_ptr tg_solutions = OrFr_tg_solutions(LOCAL_top_or_fr);
#endif /* TABLING_INNER_CUTS */
FREE_OR_FRAME(LOCAL_top_or_fr);
SCH_update_local_or_tops();
CUT_reset_prune_request();
#ifdef TABLING_INNER_CUTS
if (qg_solutions || tg_solutions) {
or_fr_ptr leftmost_or_fr;
if (qg_solutions)
CUT_join_answers_in_an_unique_frame(qg_solutions);
leftmost_or_fr = CUT_leftmost_or_frame();
LOCK_OR_FRAME(leftmost_or_fr);
if (qg_solutions)
CUT_store_answers(leftmost_or_fr, qg_solutions);
if (tg_solutions)
tg_solutions = CUT_store_tg_answers(leftmost_or_fr, tg_solutions,
BRANCH_LTT(worker_id, OrFr_depth(leftmost_or_fr)));
UNLOCK_OR_FRAME(leftmost_or_fr);
CUT_validate_tg_answers(tg_solutions);
}
#else
if (qg_solutions) {
or_fr_ptr leftmost_or_fr;
CUT_join_answers_in_an_unique_frame(qg_solutions);
leftmost_or_fr = CUT_leftmost_or_frame();
LOCK_OR_FRAME(leftmost_or_fr);
CUT_store_answers(leftmost_or_fr, qg_solutions);
UNLOCK_OR_FRAME(leftmost_or_fr);
}
#endif /* TABLING_INNER_CUTS */
}
return TRUE;
}
/* more owners */
if (nearest_livenode)
OrFr_nearest_livenode(LOCAL_top_or_fr) = nearest_livenode;
BITMAP_delete(OrFr_members(LOCAL_top_or_fr), worker_id);
#ifdef TABLING
OrFr_owners(LOCAL_top_or_fr)--;
if (BITMAP_empty(OrFr_members(LOCAL_top_or_fr))) {
#ifdef TABLING_INNER_CUTS
if (OrFr_tg_solutions(LOCAL_top_or_fr)) {
tg_sol_fr_ptr tg_solutions;
or_fr_ptr leftmost_until;
tg_solutions = OrFr_tg_solutions(LOCAL_top_or_fr);
leftmost_until = CUT_leftmost_until(LOCAL_top_or_fr, OrFr_depth(TgSolFr_gen_cp(tg_solutions)->cp_or_fr));
if (LOCAL_prune_request)
pruning_over_tabling_data_structures();
OrFr_tg_solutions(LOCAL_top_or_fr) = NULL;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
if (leftmost_until) {
LOCK_OR_FRAME(leftmost_until);
tg_solutions = CUT_store_tg_answers(leftmost_until, tg_solutions,
BRANCH_LTT(worker_id, OrFr_depth(leftmost_until)));
UNLOCK_OR_FRAME(leftmost_until);
}
CUT_validate_tg_answers(tg_solutions);
goto update_local_tops3;
}
#endif /* TABLING_INNER_CUTS */
if (LOCAL_prune_request)
pruning_over_tabling_data_structures();
}
#endif /* TABLING */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
#ifdef TABLING
#ifdef TABLING_INNER_CUTS
update_local_tops3:
#endif /* TABLING_INNER_CUTS */
if (LOCAL_top_sg_fr && LOCAL_top_cp == SgFr_gen_cp(LOCAL_top_sg_fr)) {
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
#endif /* TABLING */
SCH_update_local_or_tops();
CUT_reset_prune_request();
return TRUE;
}
static
int get_work_below(void){
int i, worker_p, big_load;
bitmap busy_below, idle_below;
worker_p = -1;
big_load = DELAYED_RELEASE_LOAD;
BITMAP_difference(busy_below, OrFr_members(LOCAL_top_or_fr), GLOBAL_bm_idle_workers);
BITMAP_difference(idle_below, OrFr_members(LOCAL_top_or_fr), busy_below);
BITMAP_delete(idle_below, worker_id);
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(idle_below ,i) && YOUNGER_CP(REMOTE_top_cp(i), LOCAL_top_cp))
BITMAP_minus(busy_below, OrFr_members(REMOTE_top_or_fr(i)));
}
if (BITMAP_empty(busy_below))
return FALSE;
/* choose the worker with highest load */
for (i = 0 ; i < number_workers; i++) {
if (BITMAP_member(busy_below ,i) && REMOTE_load(i) > big_load) {
worker_p = i;
big_load = REMOTE_load(i);
}
}
if (worker_p == -1)
return FALSE;
return (q_share_work(worker_p));
}
static
int get_work_above(void){
int i, worker_p, big_load;
bitmap visible_busy_above, visible_idle_above;
worker_p = -1;
big_load = DELAYED_RELEASE_LOAD;
BITMAP_difference(visible_busy_above, GLOBAL_bm_present_workers, OrFr_members(LOCAL_top_or_fr));
BITMAP_minus(visible_busy_above, GLOBAL_bm_invisible_workers);
BITMAP_copy(visible_idle_above, visible_busy_above);
BITMAP_minus(visible_busy_above, GLOBAL_bm_idle_workers);
BITMAP_and(visible_idle_above, GLOBAL_bm_idle_workers);
BITMAP_insert(visible_busy_above, worker_id);
for (i = 0 ; i < number_workers; i++) {
if (BITMAP_member(visible_idle_above, i))
BITMAP_minus(visible_busy_above, OrFr_members(REMOTE_top_or_fr(i)));
}
if (!BITMAP_member(visible_busy_above, worker_id) || BITMAP_alone(visible_busy_above, worker_id))
return FALSE;
BITMAP_delete(visible_busy_above, worker_id);
/* choose the worker with higher load */
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(visible_busy_above ,i) && REMOTE_load(i) > big_load) {
worker_p = i;
big_load = REMOTE_load(i);
}
}
if (worker_p == -1)
return FALSE;
/* put workers invisibles */
LOCK(GLOBAL_LOCKS_bm_invisible_workers);
if (BITMAP_member(GLOBAL_bm_invisible_workers, worker_p)) {
UNLOCK(GLOBAL_LOCKS_bm_invisible_workers);
return FALSE;
}
BITMAP_insert(GLOBAL_bm_invisible_workers, worker_id);
BITMAP_insert(GLOBAL_bm_invisible_workers, worker_p);
UNLOCK(GLOBAL_LOCKS_bm_invisible_workers);
/* move up to cp with worker_p */
do {
if (! move_up_one_node(NULL)) {
return TRUE;
}
} while (! BITMAP_member(OrFr_members(LOCAL_top_or_fr), worker_p));
/* put workers visibles */
LOCK(GLOBAL_LOCKS_bm_invisible_workers);
BITMAP_delete(GLOBAL_bm_invisible_workers, worker_id);
BITMAP_delete(GLOBAL_bm_invisible_workers, worker_p);
UNLOCK(GLOBAL_LOCKS_bm_invisible_workers);
return (q_share_work(worker_p));
}
static
int find_a_better_position(void){
int i;
bitmap busy_above, idle_above;
BITMAP_difference(busy_above, GLOBAL_bm_present_workers, OrFr_members(LOCAL_top_or_fr));
BITMAP_copy(idle_above, busy_above);
BITMAP_minus(busy_above, GLOBAL_bm_idle_workers);
BITMAP_and(idle_above, GLOBAL_bm_idle_workers);
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(idle_above, i)) {
if (BITMAP_empty(busy_above))
break;
if (BITMAP_member(OrFr_members(REMOTE_top_or_fr(i)), worker_id))
BITMAP_clear(busy_above);
BITMAP_minus(busy_above, OrFr_members(REMOTE_top_or_fr(i)));
}
}
if (BITMAP_empty(busy_above))
return FALSE;
/* move up to cp with all workers of bitmap busy_above */
do {
if (! move_up_one_node(NULL)) {
return TRUE;
}
} while (! BITMAP_subset(OrFr_members(LOCAL_top_or_fr), busy_above));
return FALSE;
}
static
int search_for_hidden_shared_work(bitmap stable_busy){
int i;
bitmap invisible_work, idle_below;
BITMAP_intersection(invisible_work, stable_busy, GLOBAL_bm_requestable_workers);
BITMAP_intersection(idle_below, OrFr_members(LOCAL_top_or_fr), GLOBAL_bm_idle_workers);
BITMAP_delete(idle_below, worker_id);
for (i = 0; i < number_workers; i++) {
if (BITMAP_member(idle_below ,i) && YOUNGER_CP(REMOTE_top_cp(i), LOCAL_top_cp))
BITMAP_minus(invisible_work, OrFr_members(REMOTE_top_or_fr(i)));
}
if (BITMAP_empty(invisible_work))
return FALSE;
/* choose the first available worker */
for (i = 0; i < number_workers; i++ ) {
if (BITMAP_member(invisible_work ,i))
break;
}
return (q_share_work(i));
}
#endif /* YAPOR */

137
OPTYap/or.structs.h Normal file
View File

@@ -0,0 +1,137 @@
/* ----------------------- **
** Struct worker **
** ----------------------- */
extern struct worker{
int worker_id;
void *worker_area[MAX_WORKERS];
long worker_offset[MAX_WORKERS];
} WORKER;
#define worker_id (WORKER.worker_id)
#define worker_area(W) (WORKER.worker_area[W])
#define worker_offset(W) (WORKER.worker_offset[W])
/* ------------------------- **
** Struct or_frame **
** ------------------------- */
typedef struct or_frame {
lockvar lock;
yamop *alternative;
volatile bitmap members;
choiceptr node;
struct or_frame *nearest_livenode;
/* cut support */
int depth;
choiceptr pending_prune_cp;
volatile int pending_prune_ltt;
struct or_frame *nearest_leftnode;
struct query_goal_solution_frame *query_solutions;
#ifdef TABLING_INNER_CUTS
struct table_subgoal_solution_frame *table_solutions;
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
/* tabling support */
volatile int number_owners;
struct or_frame *next_on_stack;
struct suspension_frame *suspensions;
struct or_frame *nearest_suspension_node;
#endif /* TABLING */
struct or_frame *next;
} *or_fr_ptr;
#define OrFr_lock(X) ((X)->lock)
#define OrFr_alternative(X) ((X)->alternative)
#define OrFr_members(X) ((X)->members)
#define OrFr_node(X) ((X)->node)
#define OrFr_nearest_livenode(X) ((X)->nearest_livenode)
#define OrFr_depth(X) ((X)->depth)
#define OrFr_pend_prune_cp(X) ((X)->pending_prune_cp)
#define OrFr_pend_prune_ltt(X) ((X)->pending_prune_ltt)
#define OrFr_nearest_leftnode(X) ((X)->nearest_leftnode)
#define OrFr_qg_solutions(X) ((X)->query_solutions)
#define OrFr_tg_solutions(X) ((X)->table_solutions)
#define OrFr_owners(X) ((X)->number_owners)
#ifdef TABLING
#define OrFr_next_on_stack(X) ((X)->next_on_stack)
#else
#define OrFr_next_on_stack(X) ((X)->next)
#endif /* TABLING */
#define OrFr_suspensions(X) ((X)->suspensions)
#define OrFr_nearest_suspnode(X) ((X)->nearest_suspension_node)
#define OrFr_next(X) ((X)->next)
/* ------------------------------------------ **
** Struct query_goal_solution_frame **
** ------------------------------------------ */
typedef struct query_goal_solution_frame{
volatile int ltt;
struct query_goal_answer_frame *first;
struct query_goal_answer_frame *last;
struct query_goal_solution_frame *next;
} *qg_sol_fr_ptr;
#define SolFr_ltt(X) ((X)->ltt)
#define SolFr_first(X) ((X)->first)
#define SolFr_last(X) ((X)->last)
#define SolFr_next(X) ((X)->next)
/* ---------------------------------------- **
** Struct query_goal_answer_frame **
** ---------------------------------------- */
typedef struct query_goal_answer_frame{
char answer[MAX_LENGTH_ANSWER];
struct query_goal_answer_frame *next;
} *qg_ans_fr_ptr;
#define AnsFr_answer(X) ((X)->answer)
#define AnsFr_next(X) ((X)->next)
#ifdef TABLING_INNER_CUTS
/* --------------------------------------------- **
** Struct table_subgoal_solution_frame **
** --------------------------------------------- */
typedef struct table_subgoal_solution_frame{
choiceptr generator_choice_point;
volatile int ltt;
struct table_subgoal_answer_frame *first_answer_frame;
struct table_subgoal_answer_frame *last_answer_frame;
struct table_subgoal_solution_frame *ltt_next;
struct table_subgoal_solution_frame *next;
} *tg_sol_fr_ptr;
#define TgSolFr_gen_cp(X) ((X)->generator_choice_point)
#define TgSolFr_ltt(X) ((X)->ltt)
#define TgSolFr_first(X) ((X)->first_answer_frame)
#define TgSolFr_last(X) ((X)->last_answer_frame)
#define TgSolFr_ltt_next(X) ((X)->ltt_next)
#define TgSolFr_next(X) ((X)->next)
/* ------------------------------------------- **
** Struct table_subgoal_answer_frame **
** ------------------------------------------- */
typedef struct table_subgoal_answer_frame{
volatile int next_free_slot;
struct answer_trie_node *answer[TG_ANSWER_SLOTS];
struct table_subgoal_answer_frame *next;
} *tg_ans_fr_ptr;
#define TgAnsFr_free_slot(X) ((X)->next_free_slot)
#define TgAnsFr_answer(X,N) ((X)->answer[N])
#define TgAnsFr_next(X) ((X)->next)
#endif /* TABLING_INNER_CUTS */

388
OPTYap/sbaamiops.h Normal file
View File

@@ -0,0 +1,388 @@
/*************************************************************************
* *
* 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. *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif /* SCCS */
#define IsArrayReference(a) ((a)->array_access_func == FunctorArrayAccess)
/* dereferencing macros */
/************************************************************
Dereferencing macros
*************************************************************/
/* For DEREFD, D has both the input and the exit argument */
/* A is only used locally */
#define deref_head(D,Label) if (IsVarTerm(D)) goto Label
#define deref_body(D,A,LabelUnk,LabelNonVar) \
do { \
if(!IsVarTerm(D)) goto LabelNonVar; \
LabelUnk: \
(A) = (CELL *)(D); \
(D) = *(CELL *)(D); \
} while (0 != (D))
#define derefa_body(D,A,LabelUnk,LabelNonVar) \
do { \
(A) = (CELL *)(D); \
(D) = *(CELL *)(D); \
if(!IsVarTerm(D)) goto LabelNonVar; \
LabelUnk: \
} while (0 != (D))
#if UNIQUE_TAG_FOR_PAIRS
/* If you have an unique tag for pairs you can use these macros which will
speed up detection of dereferenced pairs, but will be slow
for the other cases.
The only instruction where this seems useful is
switch_list_nl
*/
#define deref_list_head(D,Label) if (!IsPairTerm(D)) goto Label
#define deref_list_body(D,A,LabelList,LabelNonVar) \
do { \
if (!IsVarTerm(D)) goto LabelNonVar; \
(A) = (CELL *)(D); \
(D) = *(A); \
if (0 == (D)) break; \
if (IsPairTerm(D)) goto LabelList; \
} while (TRUE);
#endif /* UNIQUE_TAG_FOR_PAIRS */
EXTERN inline Term Deref(Term a)
{
while(IsVarTerm(a)) {
Term *b = (Term *) a;
a = *b;
if(a==0) return (Term)b;
}
return(a);
}
EXTERN inline Term Derefa(CELL *b)
{
Term a = *b;
restart:
if (!IsVarTerm(a)) {
return(a);
} else if (a == 0) {
return((CELL)b);
} else {
b = (CELL *)a;
a = *b;
goto restart;
}
}
/************************************************************
TRAIL VARIABLE
A contains the address of the variable that is to be trailed
*************************************************************/
/* #define TRAIL(A) if ((A) < HBREG || (A) > B) TrailTerm(TR++) = Unsigned(A)
*/
#define RESET_VARIABLE(V) (*(CELL *)(V) = 0)
inline EXTERN void
AlignGlobalForDouble(void)
{
/* Force Alignment for floats. Note that garbage collector may
break the alignment; */
if (!DOUBLE_ALIGNED(H)) {
RESET_VARIABLE(H);
H++;
}
}
#ifdef YAPOR
#define DO_TRAIL(TERM, VAL) \
{ \
register tr_fr_ptr r; \
r = TR; \
TR = r + 1; \
TrailTerm(r) = (CELL) (TERM); \
TrailVal(r) = (VAL); \
}
#define DO_MATRAIL(TERM, OLDVAL, NEWVAL) \
{ \
register tr_fr_ptr r = TR+1; \
TrailTerm(TR) = (OLDVAL); /* disgusting hack */ \
TrailTerm(r) = AbsAppl(TERM); \
TrailVal(r) = (NEWVAL); \
TR = r+1; \
}
#define TRAIL_REF(REF) TrailTerm(TR++) = AbsPair(((CELL *)(REF)))
/* convert to offset */
#define STACK_TO_SBA(A) (CELL *)(((char *)(A)+sba_offset))
#define IN_SBA(A) ((CELL)((char *)(A)-binding_array) < sba_size)
#define SBA_TO_STACK(A) (CELL *)(((char *)(A)-sba_offset))
/* put the binding in the SBA and force ptr to point there */
#define BIND_SHARED_VARIABLE(A, D) { \
CELL *ptr; \
/*shared_binds++;*/ \
if (IN_SBA(A)) { \
ptr = SBA_TO_STACK(A); \
DO_TRAIL(ptr,D); \
*(A) = (D); \
} else { \
DO_TRAIL((A),D); \
ptr = STACK_TO_SBA(A); \
*(A) = (CELL)ptr; \
*ptr = (D); \
} \
}
/* put the binding in the SBA and force ptr to point there */
#define MABIND_SHARED_VARIABLE(A, D) { \
/*shared_binds++;*/ \
if (IN_SBA(A)) { \
CELL *sptr = SBA_TO_STACK(A); \
DO_MATRAIL(sptr, *(A), D); \
*(A) = (D); \
} else { \
CELL *ptr3; \
DO_MATRAIL((A), *(A), D); \
ptr3 = STACK_TO_SBA(A); \
*(A) = (CELL)ptr3; \
*ptr3 = (D); \
} \
}
extern int condit_binds, shared_binds, uncond_binds;
/* put the binding in the stacks even though it is conditional */
#define BIND_CONDITIONALLY(A, D) { \
DO_TRAIL(A,D); \
/*condit_binds++; */\
*(A) = (D); \
}
/* put the binding in the stacks even though it is conditional */
#define MABIND_CONDITIONALLY(A, D) { \
DO_MATRAIL(A,*(A),D); \
/*condit_binds++; */\
*(A) = (D); \
}
#define DO_CONDITIONAL_BINDING(A,D) { \
if (Unsigned((Int)(A)-(Int)(H_FZ)) > \
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) \
{ BIND_SHARED_VARIABLE(A, D); } \
else { BIND_CONDITIONALLY(A,D); } \
}
#define DO_CONDITIONAL_MABINDING(A,D) { \
if (Unsigned((Int)(A)-(Int)(H_FZ)) > \
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) \
{ MABIND_SHARED_VARIABLE(A, D); } \
else { MABIND_CONDITIONALLY(A,D); } \
}
#define Bind(A,D) { \
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
Unsigned(BBREG)-(Int)(HBREG)) \
{ DO_CONDITIONAL_BINDING(A, D); } \
else /* uncond_binds++, */ *(A) = (D); \
}
#define BIND(A,D,L) Bind(A,D)
#define MaBind(A,D) { \
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
Unsigned(BBREG)-(Int)(HBREG)) \
{ DO_CONDITIONAL_MABINDING(A, D); } \
else /* uncond_binds++, */ *(A) = (D); \
}
/* I can't gain much here because of the frozen registers */
#define Bind_Global(A,D) Bind(A,D)
#define Bind_Local(A,D) Bind(A,D)
#define BIND_GLOBAL(A,D,L) Bind(A,D)
#define BIND_GLOBAL2(A,D,L1,L2) Bind(A,D)
#define BIND_GLOBALCELL(A,D) Bind(A,D); continue
#else /* YAPOR */
#ifdef TABLING
#define DO_TRAIL(TERM, VAL) \
{ \
register tr_fr_ptr r; \
r = TR; \
TR = r + 1; \
TrailTerm(r) = (CELL) (TERM); \
TrailVal(r) = (VAL); \
}
#define DO_MATRAIL(TERM, OLDVAL, VAL) \
{ \
register tr_fr_ptr r = TR+1; \
TrailTerm(TR) = (OLDVAL); /* disgusting hack */ \
TR = r + 1; \
TrailTerm(r) = AbsAppl((CELL *)(TERM)); \
TrailVal(r) = (NEWVAL); \
}
#define TRAIL(TERM, VAL) \
if (Unsigned((Int)(TERM)-(Int)(HBREG)) > \
Unsigned((Int)(B)-(Int)(HBREG))) \
DO_TRAIL(TERM, VAL)
#define MATRAIL(TERM, OVAL, VAL) \
if (Unsigned((Int)(TERM)-(Int)(HBREG)) > \
Unsigned((Int)(B)-(Int)(HBREG))) \
DO_MATRAIL(TERM, OVAL, VAL)
#define TRAIL_GLOBAL(TERM, VAL) \
if ((TERM) < HBREG) DO_TRAIL(TERM, VAL)
#define TRAIL_LOCAL(TERM, VAL) \
if ((TERM) > (CELL *)B) DO_TRAIL(TERM, VAL)
#define TRAIL_REF(REF) TrailTerm(TR++) = AbsPair(((CELL *)(REF)))
#define Bind(A,D) { TRAIL(A,D); *(A) = (D); }
#define MaBind(A,D) { MATRAIL(A,*(A),D); *(A) = (D); }
#define Bind_Global(A,D) { TRAIL_GLOBAL(A,D); *(A) = (D); }
#define Bind_Local(A,D) { TRAIL_LOCAL(A,D); *(A) = (D); }
#else /* TABLING */
#ifdef i386
#define DO_TRAIL(A) \
{ \
register tr_fr_ptr r; \
r = TR; \
TR = r+1; \
TrailTerm(r) = (CELL)(A); \
}
#define TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
Unsigned((Int)(B)-(Int)(HBREG))) \
DO_TRAIL(A);
#define TRAIL_GLOBAL(A) if ((A) < HBREG) DO_TRAIL(A);
#define TRAIL_LOCAL(A) if ((A) > (CELL *)B) DO_TRAIL(A);
#elif __alpha
/* alpha machines have a move conditional instruction, which avoids a
branch when jumping */
#define TRAIL(A) TrailTerm(TR) = (CELL)(A); \
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
Unsigned((Int)(B)-(Int)(HBREG))) \
TR++
#define TRAIL_GLOBAL(A) TR[0] = (CELL)(A); if ((A) < HBREG) TR++
#define TRAIL_LOCAL(A) TR[0] = (CELL)(A); if ((A) > ((CELL *)(B))) TR++
#else
#define DO_TRAIL(A) TrailTerm(TR++) = (CELL)(A)
#define TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
Unsigned((Int)(B)-(Int)(HBREG))) \
DO_TRAIL(A)
#define TRAIL_GLOBAL(A) if ((A) < HBREG) DO_TRAIL(A)
#define TRAIL_LOCAL(A) if ((A) > ((CELL *)B)) DO_TRAIL(A)
#endif /* i386, _alpha */
#define TRAIL_REF(Ref) (TrailTerm(TR++) = AbsPair(((CELL *)(Ref))))
/************************************************************
BINDING MACROS
A contains the address of the variable that is to be bound
D contains the value it will be bound to
*************************************************************/
#define Bind(A,D) { TRAIL(A); *(A) = (D); }
#define Bind_Global(A,D) { TRAIL_GLOBAL(A); *(A) = (D); }
#define Bind_Local(A,D) { TRAIL_LOCAL(A); *(A) = (D); }
/************************************************************
Binding Macros for Multiple Assignment Variables.
************************************************************/
#define MA_TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
Unsigned((Int)(B)-(Int)(HBREG))) \
{ TrailTerm(TR++) = *(A); \
TrailTerm(TR++) = AbsAppl(A); \
}
#define MaBind(A,D) { MA_TRAIL(A); *(A) = (D); }
#endif /* TABLING */
#endif /* YAPOR */
#ifdef YAPOR
/* these two fields are used for memory management with the
clean_up_node instruction in the YAPOR/SBA implementation */
#define CP_FREE(B) ((int)((B)->cp_env))
#define CP_NEXT(B) ((choiceptr)((B)->cp_cp))
#endif /* YAPOR */
#define DBIND(A,D,L) BIND(A,D,L)
#define EQ_OK_IN_CMP 1
#define LT_OK_IN_CMP 2
#define GT_OK_IN_CMP 4

91
OPTYap/sbaunify.h Normal file
View File

@@ -0,0 +1,91 @@
/*************************************************************************
* *
* 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. *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif /* SCCS */
/************************************************************
Unification Routines
*************************************************************/
static inline
Int bind_variable(Term t0, Term t1)
{
tr_fr_ptr TR0 = TR;
if (IUnify(t0,t1)) {
return(TRUE);
} else {
while(TR != TR0) {
CELL *p = (CELL *)TrailTerm(--TR);
RESET_VARIABLE(p);
}
return(FALSE);
}
}
EXTERN inline
/*
Int unify(Term t0, Term t1)
*/
Int unify(Term t0, Term t1)
{
tr_fr_ptr TR0 = TR;
if (IUnify(t0,t1)) {
return(TRUE);
} else {
while(TR != TR0) {
CELL *p = (CELL *)TrailTerm(--TR);
RESET_VARIABLE(p);
}
return(FALSE);
}
}
EXTERN inline Int unify_constant(register Term a, register Term cons)
{
CELL *pt;
deref_head(a,unify_cons_unk);
unify_cons_nonvar:
{
if (a == cons) return(TRUE);
else if (IsApplTerm(a) && IsExtensionFunctor(FunctorOfTerm(a))) {
Functor fun = FunctorOfTerm(a);
if (fun == FunctorDouble)
return(IsFloatTerm(cons) && FloatOfTerm(a) == FloatOfTerm(cons));
else if (fun == FunctorLongInt) {
return(IsLongIntTerm(cons) && LongIntOfTerm(a) == LongIntOfTerm(cons));
#ifdef TERM_EXTENSIONS
} else if (IsAttachFunc(fun)) {
return(attas[ExtFromFunctor(fun)].bind_op(SBIND,a,cons));
#endif /* TERM_EXTENSIONS */
} else
return(FALSE);
/* no other factors are accepted as arguments */
} else return(FALSE);
}
deref_body(a,pt,unify_cons_unk,unify_cons_nonvar);
Bind(pt,cons);
return(TRUE);
}

97
OPTYap/sparc_locks.h Normal file
View File

@@ -0,0 +1,97 @@
/* ------------------------------- **
** Atomic lock for SPARC **
** ------------------------------- */
#define swap_il(adr,reg) \
({ int _ret; \
asm volatile ("swap %1,%0" \
: "=r" (_ret), "=m" (*(adr)) /* Output %0,%1 */ \
: "m" (*(adr)), "0" (reg)); /* Input (%2),%0 */ \
_ret; \
})
#define TRY_LOCK(LOCK_VAR) (swap_il((LOCK_VAR),1)==0)
#define INIT_LOCK(LOCK_VAR) ((LOCK_VAR) = 0)
#define LOCK(LOCK_VAR) do { \
if (TRY_LOCK(&(LOCK_VAR))) break; \
while (IS_LOCKED(LOCK_VAR)) continue; \
} while (1)
#define IS_LOCKED(LOCK_VAR) ((LOCK_VAR) != 0)
#define IS_UNLOCKED(LOCK_VAR) ((LOCK_VAR) == 0)
#define UNLOCK(LOCK_VAR) ((LOCK_VAR) = 0)
/* Read-write spinlocks, allowing multiple readers
* but only one writer.
*
*/
typedef struct { volatile unsigned int lock; } rwlock_t;
/* Sort of like atomic_t's on Sparc, but even more clever.
*
* ------------------------------------
* | 24-bit counter | wlock | rwlock_t
* ------------------------------------
* 31 8 7 0
*
* wlock signifies the one writer is in or somebody is updating
* counter. For a writer, if he successfully acquires the wlock,
* but counter is non-zero, he has to release the lock and wait,
* till both counter and wlock are zero.
*
* Unfortunately this scheme limits us to ~16,000,000 cpus.
*/
static __inline__ void _read_lock(rwlock_t *rw)
{
register rwlock_t *lp asm("g1");
lp = rw;
__asm__ __volatile__("
mov %%o7, %%g4
call ___rw_read_enter
ldstub [%%g1 + 3], %%g2
" : /* no outputs */
: "r" (lp)
: "g2", "g4", "g7", "memory", "cc");
}
#define READ_LOCK(lock) \
do { _read_lock(&(lock)); \
} while(0)
static __inline__ void _read_unlock(rwlock_t *rw)
{
register rwlock_t *lp asm("g1");
lp = rw;
__asm__ __volatile__("
mov %%o7, %%g4
call ___rw_read_exit
ldstub [%%g1 + 3], %%g2
" : /* no outputs */
: "r" (lp)
: "g2", "g4", "g7", "memory", "cc");
}
#define READ_UNLOCK(lock) \
do { _read_unlock(&lock); \
} while(0)
static __inline__ void write_lock(rwlock_t *rw)
{
register rwlock_t *lp asm("g1");
lp = rw;
__asm__ __volatile__("
mov %%o7, %%g4
call ___rw_write_enter
ldstub [%%g1 + 3], %%g2
" : /* no outputs */
: "r" (lp)
: "g2", "g4", "g7", "memory", "cc");
}
#define WRITE_LOCK(X) write_lock(&(X))
#define WRITE_UNLOCK(rw) do { (&(rw))->lock = 0; } while(0)
#define INIT_RWLOCK(RW) (RW).lock = 0

1253
OPTYap/tab.insts.i Normal file
View File

File diff suppressed because it is too large Load Diff

965
OPTYap/tab.macros.h Normal file
View File

@@ -0,0 +1,965 @@
#include <stdlib.h>
#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 pruning_over_tabling_data_structures, (void));
STD_PROTO(static inline void abolish_incomplete_subgoals, (choiceptr));
STD_PROTO(static inline void free_subgoal_hash_chain, (sg_hash_ptr));
STD_PROTO(static inline void free_answer_hash_chain, (ans_hash_ptr));
#ifdef YAPOR
STD_PROTO(static inline void collect_suspension_frames, (or_fr_ptr));
#ifdef TIMESTAMP_CHECK
STD_PROTO(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));
#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));
/*printf*/
STD_PROTO(static inline void CUT_free_tg_solution_frame, (tg_sol_fr_ptr));
/*STD_PROTO(static inline int CUT_free_tg_solution_frame, (tg_sol_fr_ptr));*/
/*printf*/
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));
#endif /* TABLING_INNER_CUTS */
/* ----------------------- **
** Tabling Macros **
** ----------------------- */
#ifdef TAGS_FAST_OPS /* Tags_32Ops.h */
#define TabTagBits TagBits
#define TabNumberOfLowTagBits LowTagBits
#define TabVarTagBits MKTAG(0x0,0)
#define TabAtomTagBits AtomTag
#define TabNumberTagBits NumberTag
#define TabPairTagBits MKTAG(0x5,3)
#define TabApplTagBits MKTAG(0x5,0)
#else
#define TabTagBits OOOOPPS!!! Inconsistent Tabling Tag Scheme
#define TabNumberOfLowTagBits OOOOPPS!!! Inconsistent Tabling Tag Scheme
#define TabVarTagBits OOOOPPS!!! Inconsistent Tabling Tag Scheme
#define TabAtomTagBits OOOOPPS!!! Inconsistent Tabling Tag Scheme
#define TabNumberTagBits OOOOPPS!!! Inconsistent Tabling Tag Scheme
#define TabPairTagBits OOOOPPS!!! Inconsistent Tabling Tag Scheme
#define TabApplTagBits OOOOPPS!!! Inconsistent Tabling Tag Scheme
#endif /* TAGS_FAST_OPS */
#define NORM_CP(CP) ((choiceptr)(CP))
#define GEN_CP(CP) ((gen_cp_ptr)(CP))
#define CONS_CP(CP) ((cons_cp_ptr)(CP))
#define TAG_AS_ANSWER_LEAF_NODE(NODE) ((unsigned int)TrNode_parent(NODE) |= 0x1)
#define UNTAG_ANSWER_LEAF_NODE(NODE) ((ans_node_ptr)((unsigned int)NODE & 0xfffffffe))
#define IS_ANSWER_LEAF_NODE(NODE) ((unsigned int)TrNode_parent(NODE) & 0x1)
#define FREE_STACK_PUSH(ITEM, STACK) *--STACK = (CELL)(ITEM)
#define STACK_TOP(STACK) *STACK
#define STACK_POP(STACK) *STACK++
#define STACK_EMPTY(STACK, STACK_BASE) STACK == STACK_BASE
#define STACK_NOT_EMPTY(STACK, STACK_BASE) STACK != STACK_BASE
#ifdef YAPOR
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
*--STACK = (CELL)(ITEM); \
if (STACK <= STACK_TOP) \
abort_optyap("auxiliary stack full")
#else
#define STACK_PUSH(ITEM, STACK, STACK_TOP, STACK_BASE) \
*--(STACK) = (CELL)(ITEM); \
if ((STACK) <= STACK_TOP+1024) { \
CELL *NEW_STACK; \
UInt diff; \
char *OldTrailTop = (char *)TrailTop; \
growtrail(64 * 1024L); \
diff = (char *)TrailTop - OldTrailTop; \
NEW_STACK = (CELL *)((char *)(STACK)+diff); \
memmove((void *)NEW_STACK, (void *)(STACK), (char *)OldTrailTop-(char *)STACK); \
(STACK) = NEW_STACK; \
(STACK_BASE) = (CELL *)((char *)(STACK_BASE)+diff); \
}
#endif /* YAPOR */
#define MakeTableVarTerm(INDEX) (INDEX << TabNumberOfLowTagBits)
#define VarIndexOfTableTerm(TERM) (TERM >> TabNumberOfLowTagBits)
#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)
#define HASH_TABLE_LOCK(NODE) ((((unsigned 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)
#ifdef YAPOR
#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); \
DEP_ON_STACK = TRUE; \
} else { \
or_fr_ptr aux_or_fr = SgFr_gen_top_or_fr(SG_FR); \
while (! BITMAP_member(OrFr_members(aux_or_fr), worker_id)) \
aux_or_fr = OrFr_next(aux_or_fr); \
LEADER_CP = OrFr_node(aux_or_fr); \
DEP_ON_STACK = (LEADER_CP == SgFr_gen_cp(SG_FR)); \
}
#define find_leader_node(LEADER_CP, DEP_ON_STACK) \
{ dep_fr_ptr chain_dep_fr = LOCAL_top_dep_fr; \
while (YOUNGER_CP(DepFr_cons_cp(chain_dep_fr), LEADER_CP)) { \
if (LEADER_CP == DepFr_leader_cp(chain_dep_fr)) { \
DEP_ON_STACK |= DepFr_leader_dep_is_on_stack(chain_dep_fr); \
break; \
} else if (YOUNGER_CP(LEADER_CP, DepFr_leader_cp(chain_dep_fr))) { \
LEADER_CP = DepFr_leader_cp(chain_dep_fr); \
DEP_ON_STACK = DepFr_leader_dep_is_on_stack(chain_dep_fr); \
break; \
} \
chain_dep_fr = DepFr_next(chain_dep_fr); \
} \
}
#else
#define find_dependency_node(SG_FR, LEADER_CP, DEP_ON_STACK) \
LEADER_CP = SgFr_gen_cp(SG_FR); \
DEP_ON_STACK = TRUE;
#define find_leader_node(LEADER_CP, DEP_ON_STACK) \
{ dep_fr_ptr chain_dep_fr = LOCAL_top_dep_fr; \
while (YOUNGER_CP(DepFr_cons_cp(chain_dep_fr), LEADER_CP)) { \
if (EQUAL_OR_YOUNGER_CP(LEADER_CP, DepFr_leader_cp(chain_dep_fr))) { \
LEADER_CP = DepFr_leader_cp(chain_dep_fr); \
break; \
} \
chain_dep_fr = DepFr_next(chain_dep_fr); \
} \
}
#endif /* YAPOR */
#ifdef TABLING_BATCHED_SCHEDULING
#define GEN_CP_NULL_ALT NULL
#define GEN_CP_SG_FR(GCP) GEN_CP(GCP)->gcp_sg_fr
#else /* TABLING_LOCAL_SCHEDULING */
#define GEN_CP_NULL_ALT ANSWER_RESOLUTION
#define GEN_CP_SG_FR(GCP) DepFr_sg_fr(GEN_CP(GCP)->gcp_dep_fr)
#endif /* TABLING_SCHEDULING */
#define SgFr_init_scheduling_fields(SG_FR, ARITY) SgFr_arity(SG_FR) = ARITY
#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 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); \
SgFr_hash_chain(SG_Fr) = HASH
#else
#define TabEnt_init_lock_field(TAB_ENT)
#define SgHash_init_next_field(HASH, TAB_ENT) \
LOCK(TabEnt_lock(TAB_ENT)); \
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; \
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))
#else
#define TrNode_init_lock_field(NODE)
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
#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) \
ALLOC_SUSPENSION_FRAME(SUSP_FR); \
SuspFr_top_or_fr_on_stack(SUSP_FR) = TOP_OR_FR_ON_STACK; \
SuspFr_top_dep_fr(SUSP_FR) = TOP_DEP; \
SuspFr_top_sg_fr(SUSP_FR) = TOP_SG; \
SuspFr_global_reg(SUSP_FR) = (void *) (H_REG); \
SuspFr_local_reg(SUSP_FR) = (void *) (B_REG); \
SuspFr_trail_reg(SUSP_FR) = (void *) (TR_REG); \
ALLOC_BLOCK(SuspFr_global_start(SUSP_FR), H_SIZE + B_SIZE + TR_SIZE); \
SuspFr_local_start(SUSP_FR) = SuspFr_global_start(SUSP_FR) + H_SIZE; \
SuspFr_trail_start(SUSP_FR) = SuspFr_local_start(SUSP_FR) + B_SIZE; \
SuspFr_global_size(SUSP_FR) = H_SIZE; \
SuspFr_local_size(SUSP_FR) = B_SIZE; \
SuspFr_trail_size(SUSP_FR) = TR_SIZE; \
memcpy(SuspFr_global_start(SUSP_FR), SuspFr_global_reg(SUSP_FR), H_SIZE); \
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, BOTTOM_SG_NODE, ARITY, NEXT) \
{ register ans_node_ptr ans_node; \
ALLOC_SUBGOAL_FRAME(SG_FR); \
INIT_LOCK(SgFr_lock(SG_FR)); \
SgFr_init_yapor_fields(SG_FR); \
SgFr_subgoal_trie(SG_FR) = BOTTOM_SG_NODE; \
new_answer_trie_node(ans_node, 0, 0, NULL, NULL, NULL); \
SgFr_answer_trie(SG_FR) = ans_node; \
SgFr_first_answer(SG_FR) = NULL; \
SgFr_last_answer(SG_FR) = NULL; \
SgFr_hash_chain(SG_FR) = NULL; \
SgFr_state(SG_FR) = resolving; \
SgFr_init_scheduling_fields(SG_FR, ARITY); \
SgFr_next(SG_FR) = NEXT; \
}
#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); \
DepFr_sg_fr(DEP_FR) = SG_FR; \
DepFr_last_ans(DEP_FR) = NULL; \
DepFr_next(DEP_FR) = NEXT
#define new_table_entry(TAB_ENT, SUBGOAL_TRIE) \
ALLOC_TABLE_ENTRY(TAB_ENT); \
TabEnt_init_lock_field(TAB_ENT); \
TabEnt_subgoal_trie(TAB_ENT) = SUBGOAL_TRIE; \
TabEnt_hash_chain(TAB_ENT) = NULL
#define new_subgoal_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) \
ALLOC_SUBGOAL_TRIE_NODE(NODE); \
TrNode_entry(NODE) = ENTRY; \
TrNode_init_lock_field(NODE); \
TrNode_child(NODE) = CHILD; \
TrNode_parent(NODE) = PARENT; \
TrNode_next(NODE) = NEXT
#define new_answer_trie_node(NODE, INSTR, ENTRY, CHILD, PARENT, NEXT) \
ALLOC_ANSWER_TRIE_NODE(NODE); \
TrNode_instr(NODE) = INSTR; \
TrNode_entry(NODE) = ENTRY; \
TrNode_init_lock_field(NODE); \
TrNode_child(NODE) = CHILD; \
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 SUBGOAL_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS))
#define ANSWER_HASH_MARK 0
#define IS_SUBGOAL_HASH(NODE) (TrNode_entry(NODE) == SUBGOAL_HASH_MARK)
#define IS_ANSWER_HASH(NODE) (TrNode_instr(NODE) == ANSWER_HASH_MARK)
#define HASH_TERM(TERM, SEED) (((TERM) >> TabNumberOfLowTagBits) & (SEED))
#define new_subgoal_hash(HASH, NUM_NODES, TAB_ENT) \
ALLOC_SUBGOAL_HASH(HASH); \
Hash_mark(HASH) = SUBGOAL_HASH_MARK; \
Hash_num_buckets(HASH) = BASE_HASH_BUCKETS; \
ALLOC_HASH_BUCKETS(Hash_buckets(HASH), BASE_HASH_BUCKETS); \
Hash_num_nodes(HASH) = NUM_NODES; \
SgHash_init_next_field(HASH, TAB_ENT)
#define new_answer_hash(HASH, NUM_NODES, SG_FR) \
ALLOC_ANSWER_HASH(HASH); \
Hash_mark(HASH) = ANSWER_HASH_MARK; \
Hash_num_buckets(HASH) = BASE_HASH_BUCKETS; \
ALLOC_HASH_BUCKETS(Hash_buckets(HASH), BASE_HASH_BUCKETS); \
Hash_num_nodes(HASH) = NUM_NODES; \
AnsHash_init_next_field(HASH, SG_FR)
/* ------------------------- **
** Inline funcions **
** ------------------------- */
static inline
void adjust_freeze_registers(void) {
B_FZ = DepFr_cons_cp(LOCAL_top_dep_fr);
H_FZ = B_FZ->cp_h;
TR_FZ = B_FZ->cp_tr;
return;
}
static inline
void mark_as_completed(sg_fr_ptr sg_fr) {
ans_hash_ptr hash;
LOCK(SgFr_lock(sg_fr));
hash = SgFr_hash_chain(sg_fr);
SgFr_hash_chain(sg_fr) = NULL;
SgFr_state(sg_fr) = complete;
UNLOCK(SgFr_lock(sg_fr));
free_answer_hash_chain(hash);
return;
}
static inline
void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) {
#ifdef TABLING_ERRORS
if (unbind_tr < end_tr)
TABLING_ERROR_MESSAGE("unbind_tr < end_tr (function unbind_variables)");
#endif /* TABLING_ERRORS */
/* unbind loop */
while (unbind_tr != end_tr) {
CELL ref = (CELL) TrailTerm(--unbind_tr);
/* check for global or local variables */
if (IsVarTerm(ref)) {
/* unbind variable */
RESET_VARIABLE(ref);
} else if (IsPairTerm(ref)) {
ref = (CELL) RepPair(ref);
if ((ADDR)ref >= TrailBase) {
/* avoid frozen segments */
unbind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (unbind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("unbind_tr > TrailTop (function unbind_variables)");
if (unbind_tr < end_tr)
TABLING_ERROR_MESSAGE("unbind_tr < end_tr (function unbind_variables)");
#endif /* TABLING_ERRORS */
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
Term aux_val = TrailTerm(--unbind_tr);
CELL *aux_ptr = RepAppl(ref);
*aux_ptr = aux_val;
#endif
}
}
return;
}
static inline
void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) {
#ifdef TABLING_ERRORS
if (rebind_tr < end_tr)
TABLING_ERROR_MESSAGE("rebind_tr < end_tr (function rebind_variables)");
#endif /* TABLING_ERRORS */
/* rebind loop */
NEW_MAHASH((ma_h_inner_struct *)H);
while (rebind_tr != end_tr) {
CELL ref = (CELL) TrailTerm(--rebind_tr);
/* check for global or local variables */
if (IsVarTerm(ref)) {
/* rebind variable */
*((CELL *)ref) = TrailVal(rebind_tr);
} else if (IsPairTerm(ref)) {
ref = (CELL) RepPair(ref);
if ((ADDR)ref >= TrailBase) {
/* avoid frozen segments */
rebind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (rebind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("rebind_tr > TrailTop (function rebind_variables)");
if (rebind_tr < end_tr)
TABLING_ERROR_MESSAGE("rebind_tr < end_tr (function rebind_variables)");
#endif /* TABLING_ERRORS */
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
CELL *cell_ptr = RepAppl(ref);
CELL *trp;
if (!lookup_ma_var(cell_ptr)) {
/* first time we found the variable, let's put the new value */
*cell_ptr = TrailVal(rebind_tr);
}
/* skip the old value */
trp = (CELL *)rebind_tr;
rebind_tr = (tr_fr_ptr)(trp-1);
#endif
}
}
}
static inline
void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) {
CELL ref;
tr_fr_ptr end_tr;
#ifdef TABLING_ERRORS
if (unbind_tr < rebind_tr)
TABLING_ERROR_MESSAGE("unbind_tr < rebind_tr (function restore_bindings)");
#endif /* TABLING_ERRORS */
end_tr = rebind_tr;
while (unbind_tr != end_tr) {
/* unbind loop */
while (unbind_tr > end_tr) {
ref = (CELL) TrailTerm(--unbind_tr);
if (IsVarTerm(ref)) {
RESET_VARIABLE(ref);
} else if (IsPairTerm(ref)) {
ref = (CELL) RepPair(ref);
if ((ADDR)ref >= TrailBase) {
unbind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (unbind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("unbind_tr > TrailTop (function restore_bindings)");
#endif /* TABLING_ERRORS */
}
}
}
/* look for end */
while (unbind_tr < end_tr) {
ref = (CELL) TrailTerm(--end_tr);
if (IsPairTerm(ref)) {
ref = (CELL) RepPair(ref);
if ((ADDR)ref >= TrailBase) {
end_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (end_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("end_tr > TrailTop (function restore_bindings)");
#endif /* TABLING_ERRORS */
}
}
}
}
/* rebind loop */
while (rebind_tr != end_tr) {
ref = (CELL) TrailTerm(--rebind_tr);
if (IsVarTerm(ref)) {
*((CELL *)ref) = TrailVal(rebind_tr);
} else if (IsPairTerm(ref)) {
ref = (CELL) RepPair(ref);
if ((ADDR)ref >= TrailBase) {
rebind_tr = (tr_fr_ptr) ref;
#ifdef TABLING_ERRORS
if (rebind_tr > (tr_fr_ptr) TrailTop)
TABLING_ERROR_MESSAGE("rebind_tr > TrailTop (function restore_bindings)");
if (rebind_tr < end_tr)
TABLING_ERROR_MESSAGE("rebind_tr < end_tr (function restore_bindings)");
#endif /* TABLING_ERRORS */
}
}
}
return;
}
static inline
void pruning_over_tabling_data_structures(void) {
abort_optyap("pruning over tabling data structures");
return;
}
static inline
void abolish_incomplete_subgoals(choiceptr prune_cp) {
#ifdef YAPOR
if (YOUNGER_CP(OrFr_node(LOCAL_top_susp_or_fr), prune_cp))
pruning_over_tabling_data_structures();
#endif /* YAPOR */
if (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), prune_cp)) {
#ifdef YAPOR
if (PARALLEL_EXECUTION_MODE)
pruning_over_tabling_data_structures();
#endif /* YAPOR */
do {
dep_fr_ptr dep_fr = LOCAL_top_dep_fr;
LOCAL_top_dep_fr = DepFr_next(dep_fr);
FREE_DEPENDENCY_FRAME(dep_fr);
} while (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), prune_cp));
adjust_freeze_registers();
}
while (LOCAL_top_sg_fr && YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), prune_cp)) {
sg_fr_ptr sg_fr;
#ifdef YAPOR
if (PARALLEL_EXECUTION_MODE)
pruning_over_tabling_data_structures();
#endif /* YAPOR */
sg_fr = LOCAL_top_sg_fr;
LOCAL_top_sg_fr = SgFr_next(sg_fr);
TrNode_sg_fr(SgFr_subgoal_trie(sg_fr)) = NULL;
free_answer_hash_chain(SgFr_hash_chain(sg_fr));
free_answer_trie(sg_fr);
FREE_SUBGOAL_FRAME(sg_fr);
}
return;
}
static inline
void free_subgoal_hash_chain(sg_hash_ptr hash) {
while (hash) {
sg_node_ptr chain_node, *bucket, *last_bucket;
sg_hash_ptr next_hash;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(TrNode_parent(chain_node)) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_SUBGOAL_HASH(hash);
hash = next_hash;
}
return;
}
static inline
void free_answer_hash_chain(ans_hash_ptr hash) {
while (hash) {
ans_node_ptr chain_node, *bucket, *last_bucket;
ans_hash_ptr next_hash;
bucket = Hash_buckets(hash);
last_bucket = bucket + Hash_num_buckets(hash);
while (! *bucket)
bucket++;
chain_node = *bucket;
TrNode_child(UNTAG_ANSWER_LEAF_NODE(TrNode_parent(chain_node))) = chain_node;
while (++bucket != last_bucket) {
if (*bucket) {
while (TrNode_next(chain_node))
chain_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
chain_node = *bucket;
}
}
next_hash = Hash_next(hash);
FREE_HASH_BUCKETS(Hash_buckets(hash));
FREE_ANSWER_HASH(hash);
hash = next_hash;
}
return;
}
#ifdef YAPOR
static inline
void collect_suspension_frames(or_fr_ptr or_fr) {
int depth;
or_fr_ptr *susp_ptr;
#ifdef OPTYAP_ERRORS
if (IS_UNLOCKED(or_fr))
OPTYAP_ERROR_MESSAGE("or_fr unlocked (collect_suspension_frames)");
if (OrFr_suspensions(or_fr) == NULL)
OPTYAP_ERROR_MESSAGE("OrFr_suspensions(or_fr) == NULL (collect_suspension_frames)");
#endif /* OPTYAP_ERRORS */
/* order collected suspension frames by depth */
depth = OrFr_depth(or_fr);
susp_ptr = & LOCAL_top_susp_or_fr;
while (OrFr_depth(*susp_ptr) > depth)
susp_ptr = & OrFr_nearest_suspnode(*susp_ptr);
OrFr_nearest_suspnode(or_fr) = *susp_ptr;
*susp_ptr = or_fr;
return;
}
static inline
#ifdef TIMESTAMP_CHECK
susp_fr_ptr suspension_frame_to_resume(or_fr_ptr susp_or_fr, long timestamp) {
#else
susp_fr_ptr suspension_frame_to_resume(or_fr_ptr susp_or_fr) {
#endif /* TIMESTAMP_CHECK */
choiceptr top_cp;
susp_fr_ptr *susp_ptr, susp_fr;
dep_fr_ptr dep_fr;
top_cp = OrFr_node(susp_or_fr);
susp_ptr = & OrFr_suspensions(susp_or_fr);
susp_fr = *susp_ptr;
while (susp_fr) {
dep_fr = SuspFr_top_dep_fr(susp_fr);
do {
if (DepFr_last_ans(dep_fr) != SgFr_last_answer(DepFr_sg_fr(dep_fr))) {
/* unconsumed answers in susp_fr */
*susp_ptr = SuspFr_next(susp_fr);
return susp_fr;
}
#ifdef TIMESTAMP_CHECK
DepFr_timestamp(dep_fr) = timestamp;
#endif /* TIMESTAMP_CHECK */
dep_fr = DepFr_next(dep_fr);
#ifdef TIMESTAMP_CHECK
} while (timestamp > DepFr_timestamp(dep_fr) && YOUNGER_CP(DepFr_cons_cp(dep_fr), top_cp));
#else
} while (YOUNGER_CP(DepFr_cons_cp(dep_fr), top_cp));
#endif /* TIMESTAMP_CHECK */
susp_ptr = & SuspFr_next(susp_fr);
susp_fr = *susp_ptr;
}
/* no suspension frame with unconsumed answers */
return NULL;
}
#endif /* YAPOR */
#ifdef TABLING_INNER_CUTS
/* --------------------------------------------------- **
** Cut Stuff: Managing table subgoal answers **
** --------------------------------------------------- */
static inline
void CUT_store_tg_answer(or_fr_ptr or_frame, ans_node_ptr ans_node, choiceptr gen_cp, int ltt) {
tg_sol_fr_ptr tg_sol_fr, *solution_ptr, next, ltt_next;
tg_ans_fr_ptr tg_ans_fr;
solution_ptr = & OrFr_tg_solutions(or_frame);
while (*solution_ptr && YOUNGER_CP(gen_cp, TgSolFr_gen_cp(*solution_ptr))) {
solution_ptr = & TgSolFr_next(*solution_ptr);
}
if (*solution_ptr && gen_cp == TgSolFr_gen_cp(*solution_ptr)) {
if (ltt >= TgSolFr_ltt(*solution_ptr)) {
while (*solution_ptr && ltt > TgSolFr_ltt(*solution_ptr)) {
solution_ptr = & TgSolFr_ltt_next(*solution_ptr);
}
if (*solution_ptr && ltt == TgSolFr_ltt(*solution_ptr)) {
tg_ans_fr = TgSolFr_first(*solution_ptr);
if (TgAnsFr_free_slot(tg_ans_fr) == TG_ANSWER_SLOTS) {
ALLOC_TG_ANSWER_FRAME(tg_ans_fr);
TgAnsFr_free_slot(tg_ans_fr) = 1;
TgAnsFr_answer(tg_ans_fr, 0) = ans_node;
TgAnsFr_next(tg_ans_fr) = TgSolFr_first(*solution_ptr);
TgSolFr_first(*solution_ptr) = tg_ans_fr;
} else {
TgAnsFr_answer(tg_ans_fr, TgAnsFr_free_slot(tg_ans_fr)) = ans_node;
TgAnsFr_free_slot(tg_ans_fr)++;
}
return;
}
ltt_next = *solution_ptr;
next = NULL;
} else {
ltt_next = *solution_ptr;
next = TgSolFr_next(*solution_ptr);
}
} else {
ltt_next = NULL;
next = *solution_ptr;
}
ALLOC_TG_ANSWER_FRAME(tg_ans_fr);
TgAnsFr_free_slot(tg_ans_fr) = 1;
TgAnsFr_answer(tg_ans_fr, 0) = ans_node;
TgAnsFr_next(tg_ans_fr) = NULL;
ALLOC_TG_SOLUTION_FRAME(tg_sol_fr);
TgSolFr_gen_cp(tg_sol_fr) = gen_cp;
TgSolFr_ltt(tg_sol_fr) = ltt;
TgSolFr_first(tg_sol_fr) = tg_ans_fr;
TgSolFr_last(tg_sol_fr) = tg_ans_fr;
TgSolFr_ltt_next(tg_sol_fr) = ltt_next;
TgSolFr_next(tg_sol_fr) = next;
*solution_ptr = tg_sol_fr;
return;
}
static inline
tg_sol_fr_ptr CUT_store_tg_answers(or_fr_ptr or_frame, tg_sol_fr_ptr new_solution, int ltt) {
tg_sol_fr_ptr *old_solution_ptr, next_new_solution;
choiceptr node, gen_cp;
old_solution_ptr = & OrFr_tg_solutions(or_frame);
node = OrFr_node(or_frame);
while (new_solution && YOUNGER_CP(node, TgSolFr_gen_cp(new_solution))) {
next_new_solution = TgSolFr_next(new_solution);
gen_cp = TgSolFr_gen_cp(new_solution);
while (*old_solution_ptr && YOUNGER_CP(gen_cp, TgSolFr_gen_cp(*old_solution_ptr))) {
old_solution_ptr = & TgSolFr_next(*old_solution_ptr);
}
if (*old_solution_ptr && gen_cp == TgSolFr_gen_cp(*old_solution_ptr)) {
if (ltt >= TgSolFr_ltt(*old_solution_ptr)) {
tg_sol_fr_ptr *ltt_next_old_solution_ptr;
ltt_next_old_solution_ptr = old_solution_ptr;
while (*ltt_next_old_solution_ptr && ltt > TgSolFr_ltt(*ltt_next_old_solution_ptr)) {
ltt_next_old_solution_ptr = & TgSolFr_ltt_next(*ltt_next_old_solution_ptr);
}
if (*ltt_next_old_solution_ptr && ltt == TgSolFr_ltt(*ltt_next_old_solution_ptr)) {
TgAnsFr_next(TgSolFr_last(*ltt_next_old_solution_ptr)) = TgSolFr_first(new_solution);
TgSolFr_last(*ltt_next_old_solution_ptr) = TgSolFr_last(new_solution);
FREE_TG_SOLUTION_FRAME(new_solution);
} else {
TgSolFr_ltt(new_solution) = ltt;
TgSolFr_ltt_next(new_solution) = *ltt_next_old_solution_ptr;
TgSolFr_next(new_solution) = NULL;
*ltt_next_old_solution_ptr = new_solution;
}
} else {
TgSolFr_ltt(new_solution) = ltt;
TgSolFr_ltt_next(new_solution) = *old_solution_ptr;
TgSolFr_next(new_solution) = TgSolFr_next(*old_solution_ptr);
*old_solution_ptr = new_solution;
}
} else {
TgSolFr_ltt(new_solution) = ltt;
TgSolFr_ltt_next(new_solution) = NULL;
TgSolFr_next(new_solution) = *old_solution_ptr;
*old_solution_ptr = new_solution;
}
old_solution_ptr = & TgSolFr_next(*old_solution_ptr);
new_solution = next_new_solution;
}
return new_solution;
}
static inline
void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
tg_ans_fr_ptr valid_answers, free_answer;
tg_sol_fr_ptr ltt_valid_solutions, free_solution;
ans_node_ptr first_answer, last_answer, ans_node;
sg_fr_ptr sg_fr;
int slots;
while (valid_solutions) {
first_answer = last_answer = NULL;
sg_fr = GEN_CP_SG_FR(TgSolFr_gen_cp(valid_solutions));
ltt_valid_solutions = valid_solutions;
valid_solutions = TgSolFr_next(valid_solutions);
do {
valid_answers = TgSolFr_first(ltt_valid_solutions);
do {
slots = TgAnsFr_free_slot(valid_answers);
do {
ans_node = TgAnsFr_answer(valid_answers, --slots);
#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
LOCK(SgFr_lock(sg_fr));
#elif defined(TABLE_LOCK_AT_NODE_LEVEL)
LOCK(TrNode_lock(ans_node));
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
LOCK_TABLE(ans_node);
#endif /* TABLE_LOCK_LEVEL */
if (! IS_ANSWER_LEAF_NODE(ans_node)) {
TAG_AS_ANSWER_LEAF_NODE(ans_node);
if (first_answer)
TrNode_child(last_answer) = ans_node;
else
first_answer = ans_node;
last_answer = ans_node;
}
#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
UNLOCK(SgFr_lock(sg_fr));
#elif defined(TABLE_LOCK_AT_NODE_LEVEL)
UNLOCK(TrNode_lock(ans_node));
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
UNLOCK_TABLE(ans_node);
#endif /* TABLE_LOCK_LEVEL */
} while (slots);
free_answer = valid_answers;
valid_answers = TgAnsFr_next(valid_answers);
FREE_TG_ANSWER_FRAME(free_answer);
} while (valid_answers);
free_solution = ltt_valid_solutions;
ltt_valid_solutions = TgSolFr_ltt_next(ltt_valid_solutions);
FREE_TG_SOLUTION_FRAME(free_solution);
} while (ltt_valid_solutions);
if (first_answer) {
LOCK(SgFr_lock(sg_fr));
if (SgFr_first_answer(sg_fr) == NULL) {
SgFr_first_answer(sg_fr) = first_answer;
} else {
TrNode_child(SgFr_last_answer(sg_fr)) = first_answer;
}
SgFr_last_answer(sg_fr) = last_answer;
UNLOCK(SgFr_lock(sg_fr));
}
}
return;
}
static inline
void CUT_join_tg_solutions(tg_sol_fr_ptr *old_solution_ptr, tg_sol_fr_ptr new_solution) {
tg_sol_fr_ptr next_old_solution, next_new_solution;
choiceptr gen_cp;
do {
gen_cp = TgSolFr_gen_cp(new_solution);
while (*old_solution_ptr && YOUNGER_CP(gen_cp, TgSolFr_gen_cp(*old_solution_ptr))) {
old_solution_ptr = & TgSolFr_next(*old_solution_ptr);
}
if (*old_solution_ptr) {
next_old_solution = *old_solution_ptr;
*old_solution_ptr = new_solution;
CUT_join_solution_frame_tg_answers(new_solution);
if (gen_cp == TgSolFr_gen_cp(next_old_solution)) {
tg_sol_fr_ptr free_solution;
TgAnsFr_next(TgSolFr_last(new_solution)) = TgSolFr_first(next_old_solution);
TgSolFr_last(new_solution) = TgSolFr_last(next_old_solution);
free_solution = next_old_solution;
next_old_solution = TgSolFr_next(next_old_solution);
FREE_TG_SOLUTION_FRAME(free_solution);
if (! next_old_solution) {
if ((next_new_solution = TgSolFr_next(new_solution))) {
CUT_join_solution_frames_tg_answers(next_new_solution);
}
return;
}
}
gen_cp = TgSolFr_gen_cp(next_old_solution);
next_new_solution = TgSolFr_next(new_solution);
while (next_new_solution && YOUNGER_CP(gen_cp, TgSolFr_gen_cp(next_new_solution))) {
new_solution = next_new_solution;
next_new_solution = TgSolFr_next(new_solution);
CUT_join_solution_frame_tg_answers(new_solution);
}
old_solution_ptr = & TgSolFr_next(new_solution);
TgSolFr_next(new_solution) = next_old_solution;
new_solution = next_new_solution;
} else {
*old_solution_ptr = new_solution;
CUT_join_solution_frames_tg_answers(new_solution);
return;
}
} while (new_solution);
return;
}
static inline
void CUT_join_solution_frame_tg_answers(tg_sol_fr_ptr join_solution) {
tg_sol_fr_ptr next_solution;
while ((next_solution = TgSolFr_ltt_next(join_solution))) {
TgAnsFr_next(TgSolFr_last(join_solution)) = TgSolFr_first(next_solution);
TgSolFr_last(join_solution) = TgSolFr_last(next_solution);
TgSolFr_ltt_next(join_solution) = TgSolFr_ltt_next(next_solution);
FREE_TG_SOLUTION_FRAME(next_solution);
}
return;
}
static inline
void CUT_join_solution_frames_tg_answers(tg_sol_fr_ptr join_solution) {
do {
CUT_join_solution_frame_tg_answers(join_solution);
join_solution = TgSolFr_next(join_solution);
} while (join_solution);
return;
}
static inline
void CUT_free_tg_solution_frame(tg_sol_fr_ptr solution) {
tg_ans_fr_ptr current_answer, next_answer;
current_answer = TgSolFr_first(solution);
do {
next_answer = TgAnsFr_next(current_answer);
FREE_TG_ANSWER_FRAME(current_answer);
current_answer = next_answer;
} while (current_answer);
FREE_TG_SOLUTION_FRAME(solution);
return;
}
static inline
void CUT_free_tg_solution_frames(tg_sol_fr_ptr current_solution) {
tg_sol_fr_ptr ltt_solution, next_solution;
while (current_solution) {
ltt_solution = TgSolFr_ltt_next(current_solution);
while (ltt_solution) {
next_solution = TgSolFr_ltt_next(ltt_solution);
CUT_free_tg_solution_frame(ltt_solution);
ltt_solution = next_solution;
}
next_solution = TgSolFr_next(current_solution);
CUT_free_tg_solution_frame(current_solution);
current_solution = next_solution;
}
return;
}
static inline
tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr solutions, int ltt) {
tg_sol_fr_ptr ltt_next_solution, return_solution;
if (! solutions) return NULL;
return_solution = CUT_prune_tg_solution_frames(TgSolFr_next(solutions), ltt);
while (solutions && ltt > TgSolFr_ltt(solutions)) {
ltt_next_solution = TgSolFr_ltt_next(solutions);
CUT_free_tg_solution_frame(solutions);
solutions = ltt_next_solution;
}
if (solutions) {
TgSolFr_next(solutions) = return_solution;
return solutions;
} else {
return return_solution;
}
}
#endif /* TABLING_INNER_CUTS */

292
OPTYap/tab.structs.h Normal file
View File

@@ -0,0 +1,292 @@
/* ---------------------------- **
** Struct table_entry **
** ---------------------------- */
typedef struct table_entry {
#ifdef YAPOR
lockvar lock;
#endif /* YAPOR */
struct subgoal_trie_node *subgoal_trie;
struct subgoal_hash *hash_chain;
struct table_entry *next;
} *tab_ent_ptr;
#define TabEnt_lock(X) ((X)->lock)
#define TabEnt_subgoal_trie(X) ((X)->subgoal_trie)
#define TabEnt_hash_chain(X) ((X)->hash_chain)
#define TabEnt_next(X) ((X)->next)
/* -------------------------------------------------------- **
** Structs subgoal_trie_node and answer_trie_node **
** -------------------------------------------------------- */
typedef struct subgoal_trie_node {
Term entry;
#ifdef TABLE_LOCK_AT_NODE_LEVEL
lockvar lock;
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
struct subgoal_trie_node *child;
struct subgoal_trie_node *parent;
struct subgoal_trie_node *next;
} *sg_node_ptr;
typedef struct answer_trie_node {
OPCODE trie_instruction; /* u.opc */
#ifdef YAPOR
int or_arg; /* u.ld.or_arg */
#endif /* YAPOR */
Term entry;
#ifdef TABLE_LOCK_AT_NODE_LEVEL
lockvar lock;
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
struct answer_trie_node *child;
struct answer_trie_node *parent;
struct answer_trie_node *next;
} *ans_node_ptr;
#define TrNode_instr(X) ((X)->trie_instruction)
#define TrNode_or_arg(X) ((X)->or_arg)
#define TrNode_entry(X) ((X)->entry)
#define TrNode_lock(X) ((X)->lock)
#define TrNode_sg_fr(X) ((X)->child)
#define TrNode_child(X) ((X)->child)
#define TrNode_parent(X) ((X)->parent)
#define TrNode_next(X) ((X)->next)
/* ---------------------------------------------- **
** Structs subgoal_hash and answer_hash **
** ---------------------------------------------- */
typedef struct subgoal_hash {
/* the first field is used for compatibility **
** with the subgoal_trie_node data structure */
Term mark;
int number_of_buckets;
struct subgoal_trie_node **buckets;
int number_of_nodes;
struct subgoal_hash *next;
} *sg_hash_ptr;
typedef struct answer_hash {
/* the first field is used for compatibility **
** with the answer_trie_node data structure */
OPCODE mark;
int number_of_buckets;
struct answer_trie_node **buckets;
int number_of_nodes;
struct answer_hash *next;
} *ans_hash_ptr;
#define Hash_mark(X) ((X)->mark)
#define Hash_num_buckets(X) ((X)->number_of_buckets)
#define Hash_seed(X) ((X)->number_of_buckets - 1)
#define Hash_buckets(X) ((X)->buckets)
#define Hash_bucket(X,N) ((X)->buckets + N)
#define Hash_num_nodes(X) ((X)->number_of_nodes)
#define Hash_next(X) ((X)->next)
/* ------------------------------ **
** Struct subgoal_frame **
** ------------------------------ */
typedef struct subgoal_frame {
#ifdef YAPOR
lockvar lock;
int generator_worker;
struct or_frame *top_or_frame_on_generator_branch;
#endif /* YAPOR */
choiceptr generator_choice_point;
struct subgoal_trie_node *subgoal_trie;
struct answer_trie_node *answer_trie;
struct answer_trie_node *first_answer;
struct answer_trie_node *last_answer;
struct answer_hash *hash_chain;
enum {
resolving = 0,
complete = 1,
executable = 2
} state_flag;
/* vsc: needed by garbage collector to find where substitution frame for table_completion is */
int subgoal_arity;
struct subgoal_frame *next;
} *sg_fr_ptr;
#define SgFr_lock(X) ((X)->lock)
#define SgFr_gen_worker(X) ((X)->generator_worker)
#define SgFr_gen_top_or_fr(X) ((X)->top_or_frame_on_generator_branch)
#define SgFr_gen_cp(X) ((X)->generator_choice_point)
#define SgFr_subgoal_trie(X) ((X)->subgoal_trie)
#define SgFr_answer_trie(X) ((X)->answer_trie)
#define SgFr_first_answer(X) ((X)->first_answer)
#define SgFr_last_answer(X) ((X)->last_answer)
#define SgFr_hash_chain(X) ((X)->hash_chain)
#define SgFr_state(X) ((X)->state_flag)
#define SgFr_arity(X) ((X)->subgoal_arity)
#define SgFr_next(X) ((X)->next)
/* ------------------------------------------------------------------------------------------- **
SgFr_lock: lock variable 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_gen_cp: a pointer to the correspondent generator choice point.
SgFr_subgoal_trie: a pointer to the bottom subgoal trie node.
It is used to abolish incomplete subgoals.
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_hash_chain: a pointer to the first answer_hash struct for the subgoal in hand.
SgFr_state: a flag that indicates the subgoal state
SgFr_next: a pointer to chain between subgoal frames.
** ------------------------------------------------------------------------------------------- */
/* --------------------------------- **
** Struct dependency_frame **
** --------------------------------- */
typedef struct dependency_frame {
#ifdef YAPOR
lockvar lock;
int leader_dependency_is_on_stack;
struct or_frame *top_or_frame;
#ifdef TIMESTAMP_CHECK
long timestamp;
#endif /* TIMESTAMP_CHECK */
#endif /* YAPOR */
choiceptr backchain_choice_point;
choiceptr leader_choice_point;
choiceptr consumer_choice_point;
struct subgoal_frame *subgoal_frame;
struct answer_trie_node *last_consumed_answer;
struct dependency_frame *next;
} *dep_fr_ptr;
#define DepFr_lock(X) ((X)->lock)
#define DepFr_leader_dep_is_on_stack(X) ((X)->leader_dependency_is_on_stack)
#define DepFr_top_or_fr(X) ((X)->top_or_frame)
#define DepFr_timestamp(X) ((X)->timestamp)
#define DepFr_backchain_cp(X) ((X)->backchain_choice_point)
#define DepFr_leader_cp(X) ((X)->leader_choice_point)
#define DepFr_cons_cp(X) ((X)->consumer_choice_point)
#define DepFr_sg_fr(X) ((X)->subgoal_frame)
#define DepFr_last_ans(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_sg_fr: a pointer to the correspondent subgoal frame.
DepFr_last_ans: a pointer to the last consumed answer.
DepFr_next: a pointer to chain between dependency frames.
** ---------------------------------------------------------------------------------------------------- */
/* --------------------------------- **
** Struct suspension_frame **
** --------------------------------- */
#ifdef YAPOR
typedef struct suspension_frame {
struct or_frame *top_or_frame_on_stack;
struct dependency_frame *top_dependency_frame;
struct subgoal_frame *top_subgoal_frame;
struct suspended_block {
void *resume_register;
void *block_start;
long block_size;
} global_block, local_block, trail_block;
struct suspension_frame *next;
} *susp_fr_ptr;
#endif /* YAPOR */
#define SuspFr_top_or_fr_on_stack(X) ((X)->top_or_frame_on_stack)
#define SuspFr_top_dep_fr(X) ((X)->top_dependency_frame)
#define SuspFr_top_sg_fr(X) ((X)->top_subgoal_frame)
#define SuspFr_global_reg(X) ((X)->global_block.resume_register)
#define SuspFr_global_start(X) ((X)->global_block.block_start)
#define SuspFr_global_size(X) ((X)->global_block.block_size)
#define SuspFr_local_reg(X) ((X)->local_block.resume_register)
#define SuspFr_local_start(X) ((X)->local_block.block_start)
#define SuspFr_local_size(X) ((X)->local_block.block_size)
#define SuspFr_trail_reg(X) ((X)->trail_block.resume_register)
#define SuspFr_trail_start(X) ((X)->trail_block.block_start)
#define SuspFr_trail_size(X) ((X)->trail_block.block_size)
#define SuspFr_next(X) ((X)->next)
/* ----------------------------- **
** Struct generator_cp **
** ----------------------------- */
typedef struct generator_choice_point {
/* common choicepoints fields */
tr_fr_ptr gcp_tr;
CELL *gcp_h;
struct choicept *gcp_b;
#ifdef DEPTH_LIMIT
CELL gcp_depth;
#endif /* DEPTH_LIMIT */
yamop *gcp_cp;
#ifdef YAPOR
struct or_frame *gcp_or_fr;
#endif /* YAPOR */
yamop *gcp_ap;
CELL *gcp_env;
/* specific generator choicepoint fields */
#ifdef TABLING_BATCHED_SCHEDULING
struct subgoal_frame *gcp_sg_fr;
#else /* TABLING_LOCAL_SCHEDULING */
struct dependency_frame *gcp_dep_fr;
#endif /* TABLING_SCHEDULING */
} *gen_cp_ptr;
/* ---------------------------- **
** Struct consumer_cp **
** ---------------------------- */
typedef struct consumer_choice_point {
/* common choicepoints fields */
tr_fr_ptr ccp_tr;
CELL *ccp_h;
struct choicept *ccp_b;
#ifdef DEPTH_LIMIT
CELL ccp_depth;
#endif /* DEPTH_LIMIT */
yamop *ccp_cp;
#ifdef YAPOR
struct or_frame *ccp_or_fr;
#endif /* YAPOR */
yamop *ccp_ap;
CELL *ccp_env;
/* specific consumer choicepoint fields */
struct dependency_frame *ccp_dep_fr;
} *cons_cp_ptr;

412
OPTYap/tab.suspend.c Normal file
View File

@@ -0,0 +1,412 @@
/* ------------------ **
** Includes **
** ------------------ */
#include "Yap.h"
#if defined(TABLING) && defined(YAPOR)
#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);
/* -------------------------- **
** Global functions **
** -------------------------- */
void public_completion(void) {
dep_fr_ptr chain_dep_fr, next_dep_fr;
or_fr_ptr chain_or_fr, top_or_fr, next_or_fr;
susp_fr_ptr susp_fr, next_susp_fr;
qg_sol_fr_ptr solutions, aux_solutions;
if (YOUNGER_CP(LOCAL_top_cp, B_FZ)) {
/* the current node is a generator node without younger consumer **
** nodes --> we only have the current node to complete */
sg_fr_ptr top_sg_fr;
/* complete subgoals */
top_sg_fr = SgFr_next(GEN_CP_SG_FR(LOCAL_top_cp));
do {
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
} while (LOCAL_top_sg_fr != top_sg_fr);
/* no dependency frames to release */
chain_dep_fr = NULL;
/* no need to adjust freeze registers */
} else {
/* the current node is a leader node with younger consumer **
** nodes ---> we need to complete all dependent subgoals */
/* complete subgoals */
if (DepFr_leader_dep_is_on_stack(LOCAL_top_dep_fr)) {
while (LOCAL_top_sg_fr &&
EQUAL_OR_YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), LOCAL_top_cp)) {
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
} else {
while (LOCAL_top_sg_fr &&
YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), LOCAL_top_cp)) {
mark_as_completed(LOCAL_top_sg_fr);
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
}
/* chain dependency frames to release */
chain_dep_fr = NULL;
while (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), LOCAL_top_cp)) {
LOCK(DepFr_lock(LOCAL_top_dep_fr));
next_dep_fr = DepFr_next(LOCAL_top_dep_fr);
DepFr_next(LOCAL_top_dep_fr) = chain_dep_fr;
chain_dep_fr = LOCAL_top_dep_fr;
LOCAL_top_dep_fr = next_dep_fr;
}
/* adjust freeze registers */
adjust_freeze_registers();
}
/* chain or-frames to release */
chain_or_fr = NULL;
top_or_fr = LOCAL_top_cp_on_stack->cp_or_fr;
while (top_or_fr != LOCAL_top_or_fr) {
or_fr_ptr next_or_fr_on_stack;
LOCK_OR_FRAME(top_or_fr);
susp_fr = OrFr_suspensions(top_or_fr);
while (susp_fr) {
complete_suspension_branch(susp_fr, OrFr_node(top_or_fr), &chain_or_fr, &chain_dep_fr);
next_susp_fr = SuspFr_next(susp_fr);
FREE_SUSPENSION_FRAME(susp_fr);
susp_fr = next_susp_fr;
}
next_or_fr_on_stack = OrFr_next_on_stack(top_or_fr);
OrFr_next_on_stack(top_or_fr) = chain_or_fr;
chain_or_fr = top_or_fr;
top_or_fr = next_or_fr_on_stack;
}
LOCK_OR_FRAME(top_or_fr);
susp_fr = OrFr_suspensions(top_or_fr);
while (susp_fr) {
complete_suspension_branch(susp_fr, OrFr_node(top_or_fr), &chain_or_fr, &chain_dep_fr);
next_susp_fr = SuspFr_next(susp_fr);
FREE_SUSPENSION_FRAME(susp_fr);
susp_fr = next_susp_fr;
}
OrFr_suspensions(top_or_fr) = NULL;
OrFr_nearest_suspnode(top_or_fr) = top_or_fr;
UNLOCK_OR_FRAME(top_or_fr);
/* release dependency frames */
while (chain_dep_fr) {
next_dep_fr = DepFr_next(chain_dep_fr);
FREE_DEPENDENCY_FRAME(chain_dep_fr);
chain_dep_fr = next_dep_fr;
}
/* release or frames */
solutions = NULL;
while (chain_or_fr) {
aux_solutions = OrFr_qg_solutions(chain_or_fr);
if (aux_solutions) {
CUT_join_answers_in_an_unique_frame(aux_solutions);
SolFr_next(aux_solutions) = solutions;
solutions = aux_solutions;
}
next_or_fr = OrFr_next_on_stack(chain_or_fr);
FREE_OR_FRAME(chain_or_fr);
chain_or_fr = next_or_fr;
}
if (solutions) {
CUT_join_answers_in_an_unique_frame(solutions);
SolFr_next(solutions) = OrFr_qg_solutions(LOCAL_top_or_fr);
OrFr_qg_solutions(LOCAL_top_or_fr) = solutions;
}
/* adjust top register */
LOCAL_top_cp_on_stack = LOCAL_top_cp;
return;
}
void complete_suspension_frames(or_fr_ptr or_fr) {
dep_fr_ptr chain_dep_fr;
or_fr_ptr chain_or_fr;
susp_fr_ptr susp_fr;
qg_sol_fr_ptr solutions;
/* complete suspension frames */
chain_dep_fr = NULL;
chain_or_fr = NULL;
susp_fr = OrFr_suspensions(or_fr);
do {
susp_fr_ptr next_susp_fr;
complete_suspension_branch(susp_fr, OrFr_node(or_fr), &chain_or_fr, &chain_dep_fr);
next_susp_fr = SuspFr_next(susp_fr);
FREE_SUSPENSION_FRAME(susp_fr);
susp_fr = next_susp_fr;
} while (susp_fr);
OrFr_suspensions(or_fr) = NULL;
OrFr_nearest_suspnode(or_fr) = or_fr;
/* release dependency frames */
while (chain_dep_fr) {
dep_fr_ptr next_dep_fr;
next_dep_fr = DepFr_next(chain_dep_fr);
FREE_DEPENDENCY_FRAME(chain_dep_fr);
chain_dep_fr = next_dep_fr;
}
/* release or frames */
solutions = NULL;
while (chain_or_fr) {
or_fr_ptr next_or_fr;
qg_sol_fr_ptr aux_solutions;
aux_solutions = OrFr_qg_solutions(chain_or_fr);
if (aux_solutions) {
CUT_join_answers_in_an_unique_frame(aux_solutions);
SolFr_next(aux_solutions) = solutions;
solutions = aux_solutions;
}
next_or_fr = OrFr_next_on_stack(chain_or_fr);
FREE_OR_FRAME(chain_or_fr);
chain_or_fr = next_or_fr;
}
if (solutions) {
CUT_join_answers_in_an_unique_frame(solutions);
SolFr_next(solutions) = OrFr_qg_solutions(or_fr);
OrFr_qg_solutions(LOCAL_top_or_fr) = solutions;
}
return;
}
void suspend_branch(void) {
or_fr_ptr or_frame;
/* suspension only occurs in shared nodes that **
** are leaders with younger consumer nodes */
#ifdef OPTYAP_ERRORS
if (LOCAL_top_cp->cp_or_fr != LOCAL_top_or_fr)
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp->cp_or_fr != LOCAL_top_or_fr (suspend_branch)");
if (B_FZ == LOCAL_top_cp)
OPTYAP_ERROR_MESSAGE("B_FZ = LOCAL_top_cp (suspend_branch)");
if (YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, LOCAL_top_cp_on_stack) (suspend_branch)");
if (LOCAL_top_cp->cp_or_fr != LOCAL_top_or_fr)
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp->cp_or_fr != LOCAL_top_or_fr (suspend_branch)");
or_frame = LOCAL_top_cp_on_stack->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) {
if (YOUNGER_CP(LOCAL_top_cp, OrFr_node(or_frame))) {
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(LOCAL_top_cp, OrFr_node(or_frame)) (suspend_branch)");
break;
}
or_frame = OrFr_next_on_stack(or_frame);
}
#endif /* OPTYAP_ERRORS */
or_frame = LOCAL_top_cp_on_stack->cp_or_fr;
LOCK_OR_FRAME(or_frame);
if (B_FZ == LOCAL_top_cp_on_stack && OrFr_owners(or_frame) > 1) {
/* there are other workers sharing the whole branch **
** --> we can avoid suspension <-- */
/* update shared nodes */
OrFr_owners(or_frame)--;
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
while (or_frame != LOCAL_top_or_fr) {
LOCK_OR_FRAME(or_frame);
OrFr_owners(or_frame)--;
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
}
} else {
/* the branch has private parts **
** --> suspend branch <-- */
susp_fr_ptr new_susp_fr;
long h_size, b_size, tr_size;
UNLOCK_OR_FRAME(or_frame);
/* alloc suspension frame */
h_size = (unsigned long) H_FZ - (unsigned long) LOCAL_top_cp->cp_h;
b_size = (unsigned long) LOCAL_top_cp - (unsigned long) B_FZ;
tr_size = (unsigned long) TR_FZ - (unsigned long) LOCAL_top_cp->cp_tr;
new_suspension_frame(new_susp_fr, LOCAL_top_cp_on_stack->cp_or_fr, LOCAL_top_dep_fr, LOCAL_top_sg_fr,
LOCAL_top_cp->cp_h, B_FZ, LOCAL_top_cp->cp_tr, h_size, b_size, tr_size);
/* store suspension frame in current top or-frame */
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (OrFr_nearest_suspnode(LOCAL_top_or_fr) == LOCAL_top_or_fr)
OrFr_nearest_suspnode(LOCAL_top_or_fr) = NULL;
SuspFr_next(new_susp_fr) = OrFr_suspensions(LOCAL_top_or_fr);
OrFr_suspensions(LOCAL_top_or_fr) = new_susp_fr;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
}
/* adjust top pointers */
while (LOCAL_top_sg_fr && YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), LOCAL_top_cp_on_stack)) {
SgFr_gen_worker(LOCAL_top_sg_fr) = MAX_WORKERS;
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
while (LOCAL_top_sg_fr && YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), LOCAL_top_cp)) {
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
}
while (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), LOCAL_top_cp)) {
LOCAL_top_dep_fr = DepFr_next(LOCAL_top_dep_fr);
}
LOCAL_top_cp_on_stack = LOCAL_top_cp;
/* adjust freeze registers */
adjust_freeze_registers();
return;
}
void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr) {
or_fr_ptr or_frame;
sg_fr_ptr sg_frame;
/* copy suspended stacks */
memcpy(SuspFr_global_reg(resume_fr),
SuspFr_global_start(resume_fr),
SuspFr_global_size(resume_fr));
memcpy(SuspFr_local_reg(resume_fr),
SuspFr_local_start(resume_fr),
SuspFr_local_size(resume_fr));
memcpy(SuspFr_trail_reg(resume_fr),
SuspFr_trail_start(resume_fr),
SuspFr_trail_size(resume_fr));
#ifdef OPTYAP_ERRORS
if (CONS_CP(DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)))->ccp_h != SuspFr_global_reg(resume_fr) + SuspFr_global_size(resume_fr))
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr)->cp_h != SuspFr_global_reg + SuspFr_global_size (resume_suspension_frame)");
if (CONS_CP(DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)))->ccp_tr != SuspFr_trail_reg(resume_fr) + SuspFr_trail_size(resume_fr))
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr)->cp_tr != SuspFr_trail_reg + SuspFr_trail_size (resume_suspension_frame)");
if (DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)) != SuspFr_local_reg(resume_fr))
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr) != SuspFr_local_reg (resume_suspension_frame)");
if ((void *)LOCAL_top_cp < SuspFr_local_reg(resume_fr) + SuspFr_local_size(resume_fr))
OPTYAP_ERROR_MESSAGE("LOCAL_top_cp < SuspFr_local_reg + SuspFr_local_size (resume_suspension_frame)");
#endif /* OPTYAP_ERRORS */
/* update shared nodes */
or_frame = top_or_fr;
while (or_frame != LOCAL_top_or_fr) {
LOCK_OR_FRAME(or_frame);
OrFr_owners(or_frame)++;
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
}
or_frame = top_or_fr;
while (or_frame != LOCAL_top_or_fr) {
LOCK_OR_FRAME(or_frame);
BITMAP_insert(OrFr_members(or_frame), worker_id);
BRANCH(worker_id, OrFr_depth(or_frame)) = 1;
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next(or_frame);
}
/* adjust top pointers */
LOCAL_top_or_fr = top_or_fr;
LOCAL_top_cp = OrFr_node(top_or_fr);
LOCAL_top_sg_fr = SuspFr_top_sg_fr(resume_fr);
LOCAL_top_dep_fr = SuspFr_top_dep_fr(resume_fr);
LOCAL_top_cp_on_stack = OrFr_node(SuspFr_top_or_fr_on_stack(resume_fr));
sg_frame = LOCAL_top_sg_fr;
while (sg_frame && YOUNGER_CP(SgFr_gen_cp(sg_frame), LOCAL_top_cp_on_stack)) {
SgFr_gen_worker(sg_frame) = worker_id;
sg_frame = SgFr_next(sg_frame);
}
/* adjust freeze registers */
adjust_freeze_registers();
/* free suspension frame */
FREE_SUSPENSION_FRAME(resume_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 &&
! SgFr_state(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 &&
! SgFr_state(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, OrFr_node(aux_or_fr)))
OPTYAP_ERROR_MESSAGE("YOUNGER_CP(top_cp, OrFr_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, OrFr_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 */

1449
OPTYap/tab.tries.c Normal file
View File

File diff suppressed because it is too large Load Diff

752
OPTYap/tab.tries.insts.i Normal file
View File

@@ -0,0 +1,752 @@
/* ----------------------------------------------- **
** Trie instructions: stack organization **
** ----------------------------------------------- */
/*
** -------------------
** | 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 macros **
** --------------------------------------------- */
#define next_trie_instruction(NODE) \
PREG = (yamop *) TrNode_child(NODE); \
PREFETCH_OP(PREG); \
GONext()
#define next_instruction(CONDITION, NODE) \
if (CONDITION) { \
PREG = (yamop *) TrNode_child(NODE); \
} else { \
/* procceed */ \
PREG = (yamop *) CPREG; \
Y = ENV; \
} \
PREFETCH_OP(PREG); \
GONext()
/* -------------------------------------------------------------- **
** the 'store_trie_choice_point', 'restore_trie_choice_point' and **
** 'pop_trie_choice_point' macros do not include the 'set_cut' **
** macro because there are no cuts in trie instructions. **
** -------------------------------------------------------------- */
#define store_trie_choice_point(PTR, AP) \
{ register choiceptr cp; \
cp = --NORM_CP(PTR); \
HBREG = H; \
cp->cp_tr = TR; \
cp->cp_h = H; \
cp->cp_b = B; \
cp->cp_cp = CPREG; \
cp->cp_ap = (yamop *) AP; \
cp->cp_env= ENV; \
B = cp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
}
#define restore_trie_choice_point(AP) \
H = HBREG = PROTECT_FROZEN_H(B); \
CPREG = B->cp_cp; \
ENV = B->cp_env; \
YAPOR_update_alternative(PREG, (yamop *) AP) \
B->cp_ap = (yamop *) AP; \
Y = (CELL *) PROTECT_FROZEN_B(B); \
SET_BB(NORM_CP(Y))
#define pop_trie_choice_point() \
Y = (CELL *) PROTECT_FROZEN_B((B+1)); \
H = PROTECT_FROZEN_H(B); \
CPREG = B->cp_cp; \
TABLING_close_alt(B); \
ENV = B->cp_env; \
B = B->cp_b; \
HBREG = PROTECT_FROZEN_H(B); \
SET_BB(PROTECT_FROZEN_B(B))
#define no_cp_trie_var_instr() \
if (heap_arity) { \
*aux_ptr = heap_arity - 1; \
var_ptr = *++aux_ptr; \
*((CELL *) var_ptr) = var_ptr; \
for (i = 0; i < heap_arity - 1; i++) \
*aux_ptr++ = *(aux_ptr + 1); \
*aux_ptr++ = vars_arity + 1; \
*aux_ptr++ = subs_arity; \
for (i = 0; i < subs_arity; i++) \
*aux_ptr++ = *(aux_ptr + 1); \
*aux_ptr = var_ptr; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
*++aux_ptr = vars_arity + 1; \
*++aux_ptr = subs_arity - 1; \
/* var_ptr = *(aux_ptr + subs_arity); */ \
/* Bind((CELL *) var_ptr, var_ptr); */ \
next_instruction(--subs_arity, node); \
}
#define cp_trie_var_instr() \
if (heap_arity) { \
var_ptr = *++aux_ptr; \
*((CELL *) var_ptr) = var_ptr; \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity; i++) \
*--Y = *aux_ptr--; \
*--Y = var_ptr; \
for (i = 0; i < subs_arity; i++) \
*--Y = *aux_ptr--; \
*--Y = subs_arity; \
*--Y = vars_arity + 1; \
aux_ptr--; \
for (i = 1; i < heap_arity; i++) \
*--Y = *--aux_ptr; \
*--Y = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
/* var_ptr = *aux_ptr; */ \
/* Bind((CELL *) var_ptr, var_ptr); */ \
aux_ptr += vars_arity; \
for (i = 0; i < subs_arity + vars_arity; i++) \
*--Y = *aux_ptr--; \
*--Y = subs_arity - 1; \
*--Y = vars_arity + 1; \
*--Y = 0; \
next_instruction(--subs_arity, node); \
}
#define no_cp_trie_val_instr() \
if (heap_arity) { \
Y = ++aux_ptr; \
subs_ptr = aux_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \
aux = *aux_ptr; \
subs = *subs_ptr; \
if (aux > subs) { \
*((CELL *) aux) = subs; \
} else { \
*((CELL *) aux) = aux; \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
*aux_ptr = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
aux_ptr += 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
subs_ptr = aux_ptr + vars_arity - var_index; \
aux = *aux_ptr; \
subs = *subs_ptr; \
if (aux > subs) { \
if ((CELL *) aux <= H) { \
Bind_Global((CELL *) aux, subs); \
} else if ((CELL *) subs <= H) { \
Bind_Local((CELL *) aux, subs); \
} else { \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
} else { \
if ((CELL *) subs <= H) { \
Bind_Global((CELL *) subs, aux); \
*subs_ptr = aux; \
} else if ((CELL *) aux <= H) { \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} else { \
Bind_Local((CELL *) aux, subs); \
} \
} \
for (i = 0; i < vars_arity; i++) \
*aux_ptr++ = *(aux_ptr + 1); \
next_instruction(--subs_arity, node); \
}
#define cp_trie_val_instr() \
if (heap_arity) { \
aux_ptr++; \
subs_ptr = aux_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \
aux = *aux_ptr; \
subs = *subs_ptr; \
if (aux > subs) { \
*((CELL *) aux) = subs; \
} else { \
*((CELL *) aux) = aux; \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) \
*--Y = *aux_ptr--; \
*--Y = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
subs_ptr = aux_ptr + vars_arity - var_index; \
aux = *aux_ptr; \
subs = *subs_ptr; \
if (aux > subs) { \
if ((CELL *) aux <= H) { \
Bind_Global((CELL *) aux, subs); \
} else if ((CELL *) subs <= H) { \
Bind_Local((CELL *) aux, subs); \
} else { \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
} else { \
if ((CELL *) subs <= H) { \
Bind_Global((CELL *) subs, aux); \
*subs_ptr = aux; \
} else if ((CELL *) aux <= H) { \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} else { \
Bind_Local((CELL *) aux, subs); \
} \
} \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--Y = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--Y = *--aux_ptr; \
*--Y = subs_arity - 1; \
*--Y = vars_arity; \
*--Y = 0; \
next_instruction(--subs_arity, node); \
}
#define no_cp_trie_atom_instr() \
if (heap_arity) { \
Y = ++aux_ptr; \
/* *((CELL *) *aux_ptr) = TrNode_entry(node); */ \
Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \
*aux_ptr = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
aux_ptr += 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, TrNode_entry(node)); \
for (i = 0; i < vars_arity; i++) \
*aux_ptr++ = *(aux_ptr + 1); \
next_instruction(--subs_arity, node); \
}
#define cp_trie_atom_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = TrNode_entry(node); */ \
Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) \
*--Y = *aux_ptr--; \
*--Y = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, TrNode_entry(node)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--Y = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--Y = *--aux_ptr; \
*--Y = subs_arity - 1; \
*--Y = vars_arity; \
*--Y = 0; \
next_instruction(--subs_arity, node); \
}
#define no_cp_trie_list_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsPair(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = heap_arity - 1 + 2; \
Y = aux_ptr; \
} else { \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = 2; \
Y = aux_ptr; \
aux_ptr += 2 + 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, AbsPair(H - 2)); \
for (i = 0; i < vars_arity; i++) \
*aux_ptr++ = *(aux_ptr + 1); \
} \
next_trie_instruction(node)
#define cp_trie_list_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsPair(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity + subs_arity + heap_arity + 1; i++) \
*--Y = *aux_ptr--; \
H += 2; \
*--Y = (CELL) (H - 1); \
*--Y = (CELL) (H - 2); \
*--Y = heap_arity + 1; \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, AbsPair(H)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--Y = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--Y = *--aux_ptr; \
*--Y = subs_arity - 1; \
*--Y = vars_arity; \
H += 2; \
*--Y = (CELL) (H - 1); \
*--Y = (CELL) (H - 2); \
*--Y = 2; \
} \
next_trie_instruction(node)
#define no_cp_trie_struct_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsAppl(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*aux_ptr-- = (CELL) (H - i); \
*aux_ptr = heap_arity - 1 + func_arity; \
Y = aux_ptr; \
} else { \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*aux_ptr-- = (CELL) (H - i); \
*aux_ptr = func_arity; \
Y = aux_ptr; \
aux_ptr += func_arity + 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, AbsAppl(H - func_arity - 1)); \
for (i = 0; i < vars_arity; i++) \
*aux_ptr++ = *(aux_ptr + 1); \
} \
next_trie_instruction(node)
#define cp_trie_struct_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsAppl(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity + subs_arity + heap_arity + 1; i++) \
*--Y = *aux_ptr--; \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*--Y = (CELL) (H - i); \
*--Y = heap_arity + func_arity - 1; \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, AbsAppl(H)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--Y = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--Y = *--aux_ptr; \
*--Y = subs_arity - 1; \
*--Y = vars_arity; \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*--Y = (CELL) (H - i); \
*--Y = func_arity; \
} \
next_trie_instruction(node)
/* --------------------------- **
** Trie instructions **
** --------------------------- */
PBOp(trie_do_var, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
register CELL var_ptr;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
no_cp_trie_var_instr();
ENDPBOp();
PBOp(trie_try_var, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
register CELL var_ptr;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(Y, TrNode_next(node));
cp_trie_var_instr();
ENDPBOp();
PBOp(trie_retry_var, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
register CELL var_ptr;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
cp_trie_var_instr();
ENDPBOp();
PBOp(trie_trust_var, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
register CELL var_ptr;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
cp_trie_var_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
if ((choiceptr) Y == B_FZ) {
cp_trie_var_instr();
} else {
no_cp_trie_var_instr();
}
}
ENDPBOp();
PBOp(trie_do_val, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y, *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i;
no_cp_trie_val_instr();
ENDPBOp();
PBOp(trie_try_val, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y, *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i;
store_trie_choice_point(Y, TrNode_next(node));
cp_trie_val_instr();
ENDPBOp();
PBOp(trie_retry_val, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1), *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i;
restore_trie_choice_point(TrNode_next(node));
cp_trie_val_instr();
ENDPBOp();
PBOp(trie_trust_val, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1), *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
cp_trie_val_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
if ((choiceptr) Y == B_FZ) {
cp_trie_val_instr();
} else {
no_cp_trie_val_instr();
}
}
ENDPBOp();
PBOp(trie_do_atom, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
no_cp_trie_atom_instr();
ENDPBOp();
PBOp(trie_try_atom, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(Y, TrNode_next(node));
cp_trie_atom_instr();
ENDPBOp();
PBOp(trie_retry_atom, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
cp_trie_atom_instr();
ENDPBOp();
PBOp(trie_trust_atom, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
cp_trie_atom_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
if ((choiceptr) Y == B_FZ) {
cp_trie_atom_instr();
} else {
no_cp_trie_atom_instr();
}
}
ENDPBOp();
PBOp(trie_do_list, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
no_cp_trie_list_instr();
ENDPBOp();
PBOp(trie_try_list, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(Y, TrNode_next(node));
cp_trie_list_instr();
ENDPBOp();
PBOp(trie_retry_list, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
cp_trie_list_instr();
ENDPBOp();
PBOp(trie_trust_list, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
cp_trie_list_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
if ((choiceptr) Y == B_FZ) {
cp_trie_list_instr();
} else {
no_cp_trie_list_instr();
}
}
ENDPBOp();
PBOp(trie_do_struct, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
Functor func = (Functor) NonTagPart(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
no_cp_trie_struct_instr();
ENDPBOp();
PBOp(trie_try_struct, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = Y;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
Functor func = (Functor) NonTagPart(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
store_trie_choice_point(Y, TrNode_next(node));
cp_trie_struct_instr();
ENDPBOp();
PBOp(trie_retry_struct, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
Functor func = (Functor) NonTagPart(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
restore_trie_choice_point(TrNode_next(node));
cp_trie_struct_instr();
ENDPBOp();
PBOp(trie_trust_struct, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
Functor func = (Functor) NonTagPart(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
cp_trie_struct_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
if ((choiceptr) Y == B_FZ) {
cp_trie_struct_instr();
} else {
no_cp_trie_struct_instr();
}
}
ENDPBOp();

91
OPTYap/x86_locks.h Normal file
View File

@@ -0,0 +1,91 @@
/* ----------------------------- **
** Atomic lock for X86 **
** ----------------------------- */
#define swap(reg,adr) \
({ \
char _ret; \
asm volatile ("xchgb %0,%1" \
: "=q" (_ret), "=m" (*(adr)) /* Output %0,%1 */ \
: "m" (*(adr)), "0" (reg)); /* Input (%2),%0 */ \
_ret; \
})
#define TRY_LOCK(LOCK_VAR) (swap(1,(LOCK_VAR))==0)
#define INIT_LOCK(LOCK_VAR) ((LOCK_VAR) = 0)
#define LOCK(LOCK_VAR) do { \
if (TRY_LOCK(&(LOCK_VAR))) break; \
SIMICS_SERVICE(START_COUNTER, 11); \
while (IS_LOCKED(LOCK_VAR)) continue; \
SIMICS_SERVICE(STOP_COUNTER, 11); \
} while (1)
#define IS_LOCKED(LOCK_VAR) ((LOCK_VAR) != 0)
#define IS_UNLOCKED(LOCK_VAR) ((LOCK_VAR) == 0)
#define UNLOCK(LOCK_VAR) ((LOCK_VAR) = 0)
/* This code has been copied from the sources of the Linux kernel */
/*
* On x86, we implement read-write locks as a 32-bit counter
* with the high bit (sign) being the "contended" bit.
*
* The inline assembly is non-obvious. Think about it.
*
* Changed to use the same technique as rw semaphores. See
* semaphore.h for details. -ben
*/
/* the spinlock helpers are in arch/i386/kernel/semaphore.S */
typedef struct { unsigned long a[100]; } __dummy_lock_t;
#define __dummy_lock(lock) (*(__dummy_lock_t *)(lock))
typedef struct { volatile unsigned int lock; } rwlock_t;
#define RW_LOCK_BIAS 0x01000000
#define RW_LOCK_BIAS_STR "0x01000000"
#define RW_LOCK_UNLOCKED RW_LOCK_BIAS
#define __build_read_lock(rw, helper) \
asm volatile("lock\n" \
"subl $1,(%0)\n\t" \
"js 2f\n" \
"1:\n" \
".section .text.lock,\"ax\"\n" \
"2:\tcall __read_lock_failed\n\t" \
"jmp 1b\n" \
".previous" \
::"a" (rw) : "memory")
#define __build_write_lock(rw, helper) \
asm volatile("lock\n"\
"subl $" RW_LOCK_BIAS_STR ",(%0)\n\t" \
"jnz 2f\n" \
"1:\n" \
".section .text.lock,\"ax\"\n" \
"2:\tcall __write_lock_failed\n\t" \
"jmp 1b\n" \
".previous" \
::"a" (rw) : "memory")
static inline void read_lock(rwlock_t *rw)
{
__build_read_lock(rw, "__read_lock_failed");
}
static inline void write_lock(rwlock_t *rw)
{
__build_write_lock(rw, "__write_lock_failed");
}
#define READ_LOCK(X) read_lock(&(X))
#define WRITE_LOCK(X) write_lock(&(X))
#define READ_UNLOCK(rw) asm volatile("lock ; incl %0" :"=m" (__dummy_lock(&(rw))))
#define WRITE_UNLOCK(rw) asm volatile("lock ; addl $" RW_LOCK_BIAS_STR ",%0":"=m" (__dummy_lock(&(rw))))
#define INIT_RWLOCK(RW) (RW).lock = RW_LOCK_UNLOCKED