2006-08-22 17:12:46 +01:00
|
|
|
/*************************************************************************
|
|
|
|
* *
|
|
|
|
* YAP Prolog *
|
|
|
|
* *
|
|
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
|
|
* *
|
|
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
|
|
* *
|
|
|
|
**************************************************************************
|
|
|
|
* *
|
|
|
|
* File: non backtrackable term support *
|
|
|
|
* Last rev: 2/8/06 *
|
|
|
|
* mods: *
|
|
|
|
* comments: non-backtrackable term support *
|
|
|
|
* *
|
|
|
|
*************************************************************************/
|
|
|
|
#ifdef SCCS
|
|
|
|
static char SccsId[] = "%W% %G%";
|
|
|
|
#endif
|
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
/**
|
2015-11-18 15:06:25 +00:00
|
|
|
* @file globals.c
|
|
|
|
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
|
|
|
|
* @date Tue Nov 17 23:16:17 2015
|
|
|
|
*
|
|
|
|
* @brief support for backtrable and non-backtrackable variables in Prolog.
|
|
|
|
*
|
|
|
|
*
|
|
|
|
*/
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-11-18 15:06:25 +00:00
|
|
|
/**
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
@defgroup Global_Variables Global Variables
|
2015-01-04 23:58:23 +00:00
|
|
|
@ingroup builtins
|
2014-09-11 20:06:57 +01:00
|
|
|
@{
|
|
|
|
|
|
|
|
Global variables are associations between names (atoms) and
|
|
|
|
terms. They differ in various ways from storing information using
|
|
|
|
assert/1 or recorda/3.
|
|
|
|
|
|
|
|
+ The value lives on the Prolog (global) stack. This implies that
|
|
|
|
lookup time is independent from the size of the term. This is
|
|
|
|
particularly interesting for large data structures such as parsed XML
|
2015-10-20 08:13:09 +01:00
|
|
|
documents or the CHR global constraint store.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
+ They support both global assignment using nb_setval/2 and
|
|
|
|
backtrackable assignment using b_setval/2.
|
|
|
|
|
|
|
|
+ Only one value (which can be an arbitrary complex Prolog term)
|
2015-10-20 08:13:09 +01:00
|
|
|
can be associated to a variable at a time.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
+ Their value cannot be shared among threads. Each thread has its own
|
|
|
|
namespace and values for global variables.
|
|
|
|
|
|
|
|
|
|
|
|
Currently global variables are scoped globally. We may consider module
|
|
|
|
scoping in future versions. Both b_setval/2 and
|
|
|
|
nb_setval/2 implicitly create a variable if the referenced name
|
|
|
|
does not already refer to a variable.
|
|
|
|
|
2015-11-05 16:38:18 +00:00
|
|
|
Global variables may be initialized from directives to make them
|
2014-09-11 20:06:57 +01:00
|
|
|
available during the program lifetime, but some considerations are
|
|
|
|
necessary for saved-states and threads. Saved-states to not store
|
|
|
|
global variables, which implies they have to be declared with
|
|
|
|
initialization/1 to recreate them after loading the saved
|
|
|
|
state. Each thread has its own set of global variables, starting with
|
|
|
|
an empty set. Using `thread_initialization/1` to define a global
|
|
|
|
variable it will be defined, restored after reloading a saved state
|
|
|
|
and created in all threads that are created after the
|
2015-11-05 16:38:18 +00:00
|
|
|
registration. Finally, global variables can be initialized using the
|
2014-09-11 20:06:57 +01:00
|
|
|
exception hook called exception/3. The latter technique is used
|
|
|
|
by CHR.
|
|
|
|
|
|
|
|
SWI-Prolog global variables are associations between names (atoms) and
|
|
|
|
terms. They differ in various ways from storing information using
|
|
|
|
assert/1 or recorda/3.
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
+ The value lives on the Prolog (global) stack. This implies
|
2014-09-11 20:06:57 +01:00
|
|
|
that lookup time is independent from the size of the term.
|
|
|
|
This is particulary interesting for large data structures
|
|
|
|
such as parsed XML documents or the CHR global constraint
|
|
|
|
store.
|
|
|
|
|
|
|
|
They support both global assignment using nb_setval/2 and
|
|
|
|
backtrackable assignment using b_setval/2.
|
|
|
|
|
|
|
|
+ Only one value (which can be an arbitrary complex Prolog
|
|
|
|
term) can be associated to a variable at a time.
|
|
|
|
|
|
|
|
+ Their value cannot be shared among threads. Each thread
|
|
|
|
has its own namespace and values for global variables.
|
|
|
|
|
|
|
|
+ Currently global variables are scoped globally. We may
|
|
|
|
consider module scoping in future versions.
|
|
|
|
|
|
|
|
|
|
|
|
Both b_setval/2 and nb_setval/2 implicitly create a variable if the
|
|
|
|
referenced name does not already refer to a variable.
|
|
|
|
|
2015-11-05 16:38:18 +00:00
|
|
|
Global variables may be initialized from directives to make them
|
2014-09-11 20:06:57 +01:00
|
|
|
available during the program lifetime, but some considerations are
|
|
|
|
necessary for saved-states and threads. Saved-states to not store global
|
|
|
|
variables, which implies they have to be declared with initialization/1
|
|
|
|
to recreate them after loading the saved state. Each thread has
|
|
|
|
its own set of global variables, starting with an empty set. Using
|
|
|
|
`thread_inititialization/1` to define a global variable it will be
|
|
|
|
defined, restored after reloading a saved state and created in all
|
|
|
|
threads that are created <em>after</em> the registration.
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
|
|
|
|
2006-08-22 17:12:46 +01:00
|
|
|
#include "Yap.h"
|
|
|
|
#include "Yatom.h"
|
2009-10-23 14:22:17 +01:00
|
|
|
#include "YapHeap.h"
|
2006-08-22 17:12:46 +01:00
|
|
|
#include "yapio.h"
|
|
|
|
#include "iopreds.h"
|
2017-02-20 15:28:46 +00:00
|
|
|
#include "YapEval.h"
|
2006-08-22 17:12:46 +01:00
|
|
|
#include "attvar.h"
|
2009-02-27 00:31:29 +00:00
|
|
|
#include <math.h>
|
2006-08-22 17:12:46 +01:00
|
|
|
|
|
|
|
/* Non-backtrackable terms will from now on be stored on arenas, a
|
|
|
|
special term on the heap. Arenas automatically contract as we add terms to
|
|
|
|
the front.
|
|
|
|
|
|
|
|
*/
|
|
|
|
|
2010-03-12 22:40:17 +00:00
|
|
|
#define QUEUE_FUNCTOR_ARITY 4
|
|
|
|
|
2006-08-22 17:12:46 +01:00
|
|
|
#define QUEUE_ARENA 0
|
2010-03-08 09:21:48 +00:00
|
|
|
#define QUEUE_HEAD 1
|
|
|
|
#define QUEUE_TAIL 2
|
|
|
|
#define QUEUE_SIZE 3
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2010-03-12 22:40:17 +00:00
|
|
|
#define HEAP_FUNCTOR_MIN_ARITY
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
#define HEAP_SIZE 0
|
|
|
|
#define HEAP_MAX 1
|
2006-08-25 20:50:35 +01:00
|
|
|
#define HEAP_ARENA 2
|
2010-03-08 09:21:48 +00:00
|
|
|
#define HEAP_START 3
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2014-09-10 05:50:43 +01:00
|
|
|
#define MIN_ARENA_SIZE (1048L)
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
#define MAX_ARENA_SIZE (2048 * 16)
|
2008-10-29 18:21:41 +00:00
|
|
|
|
2006-08-25 20:50:35 +01:00
|
|
|
#define Global_MkIntegerTerm(I) MkIntegerTerm(I)
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static UInt big2arena_sz(CELL *arena_base) {
|
|
|
|
return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) +
|
|
|
|
sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) /
|
|
|
|
sizeof(CELL);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static UInt arena2big_sz(UInt sz) {
|
|
|
|
return sz -
|
|
|
|
(sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
/* pointer to top of an arena */
|
2015-10-20 08:13:09 +01:00
|
|
|
static inline CELL *ArenaLimit(Term arena) {
|
2006-08-22 17:12:46 +01:00
|
|
|
CELL *arena_base = RepAppl(arena);
|
|
|
|
UInt sz = big2arena_sz(arena_base);
|
2015-10-20 08:13:09 +01:00
|
|
|
return arena_base + sz;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
/* pointer to top of an arena */
|
2015-10-20 08:13:09 +01:00
|
|
|
static inline CELL *ArenaPt(Term arena) { return (CELL *)RepAppl(arena); }
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static inline UInt ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); }
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Term CreateNewArena(CELL *ptr, UInt size) {
|
2008-12-05 16:08:44 +00:00
|
|
|
Term t = AbsAppl(ptr);
|
|
|
|
MP_INT *dst;
|
|
|
|
|
|
|
|
ptr[0] = (CELL)FunctorBigInt;
|
|
|
|
ptr[1] = EMPTY_ARENA;
|
2015-10-20 08:13:09 +01:00
|
|
|
dst = (MP_INT *)(ptr + 2);
|
2008-12-05 16:08:44 +00:00
|
|
|
dst->_mp_size = 0L;
|
2015-10-20 08:13:09 +01:00
|
|
|
dst->_mp_alloc = (sizeof(CELL) / sizeof(mp_limb_t)) * arena2big_sz(size);
|
|
|
|
ptr[size - 1] = EndSpecials;
|
2008-12-05 16:08:44 +00:00
|
|
|
return t;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Term NewArena(UInt size, int wid, UInt arity, CELL *where) {
|
2006-08-22 17:12:46 +01:00
|
|
|
Term t;
|
2006-12-13 16:10:26 +00:00
|
|
|
UInt new_size;
|
2014-10-13 12:34:52 +01:00
|
|
|
WORKER_REGS(wid)
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
if (where == NULL || where == HR) {
|
2015-10-20 08:13:09 +01:00
|
|
|
while (HR + size > ASP - 1024) {
|
|
|
|
if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return TermNil;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
t = CreateNewArena(HR, size);
|
|
|
|
HR += size;
|
2006-08-22 17:12:46 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
|
|
|
|
"No Stack Space for Non-Backtrackable terms");
|
2006-08-22 17:12:46 +01:00
|
|
|
return TermNil;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
size = new_size / sizeof(CELL);
|
2006-08-22 17:12:46 +01:00
|
|
|
t = CreateNewArena(where, size);
|
|
|
|
}
|
|
|
|
return t;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_allocate_arena(USES_REGS1) {
|
2006-08-22 17:12:46 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "allocate_arena");
|
2006-08-22 17:12:46 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsIntegerTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, t, "allocate_arena");
|
|
|
|
return FALSE;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ARG2, NewArena(IntegerOfTerm(t), worker_id, 1, NULL));
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_default_arena_size(USES_REGS1) {
|
|
|
|
return Yap_unify(ARG1, MkIntegerTerm(ArenaSz(LOCAL_GlobalArena)));
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
void Yap_AllocateDefaultArena(Int gsize, Int attsize, int wid) {
|
2014-10-13 12:34:52 +01:00
|
|
|
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2008-12-29 00:11:05 +00:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static void adjust_cps(UInt size USES_REGS) {
|
2007-09-27 16:25:34 +01:00
|
|
|
/* adjust possible back pointers in choice-point stack */
|
|
|
|
choiceptr b_ptr = B;
|
2014-01-19 21:15:05 +00:00
|
|
|
while (b_ptr->cp_h == HR) {
|
2007-09-27 16:25:34 +01:00
|
|
|
b_ptr->cp_h += size;
|
|
|
|
b_ptr = b_ptr->cp_b;
|
|
|
|
}
|
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
|
|
|
|
UInt arity USES_REGS) {
|
2011-05-04 10:11:41 +01:00
|
|
|
LOCAL_ArenaOverflows++;
|
2006-08-22 17:12:46 +01:00
|
|
|
if (size == 0) {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (old_size < 128 * 1024) {
|
2006-08-22 17:12:46 +01:00
|
|
|
size = old_size;
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
size = old_size + 128 * 1024;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
if (size < 4096) {
|
|
|
|
size = 4096;
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
if (pt == HR) {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (HR + size > ASP - 1024) {
|
2006-09-29 19:59:00 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
XREGS[arity + 1] = arena;
|
|
|
|
if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return FALSE;
|
2006-09-01 21:14:42 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
arena = XREGS[arity + 1];
|
2007-09-28 14:10:46 +01:00
|
|
|
/* we don't know if the GC added junk on top of the global */
|
|
|
|
pt = ArenaLimit(arena);
|
2011-03-07 16:02:55 +00:00
|
|
|
return GrowArena(arena, pt, old_size, size, arity PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
adjust_cps(size PASS_REGS);
|
2014-01-19 21:15:05 +00:00
|
|
|
HR += size;
|
2006-08-22 17:12:46 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
XREGS[arity + 1] = arena;
|
2007-09-24 10:02:33 +01:00
|
|
|
/* try to recover some room */
|
2015-10-20 08:13:09 +01:00
|
|
|
if (arena == LOCAL_GlobalArena && 10 * (pt - H0) > 8 * (HR - H0)) {
|
|
|
|
if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return FALSE;
|
2007-09-24 10:02:33 +01:00
|
|
|
}
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
arena = XREGS[arity + 1];
|
2007-09-28 14:10:46 +01:00
|
|
|
pt = ArenaLimit(arena);
|
2015-10-20 08:13:09 +01:00
|
|
|
if ((size = Yap_InsertInGlobal(pt, size * sizeof(CELL))) == 0) {
|
2007-09-28 14:10:46 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
size = size / sizeof(CELL);
|
|
|
|
arena = XREGS[arity + 1];
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
CreateNewArena(ArenaPt(arena), size + old_size);
|
2006-08-22 17:12:46 +01:00
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2015-10-20 08:13:09 +01:00
|
|
|
restart : {
|
|
|
|
Term arena = *arenap;
|
|
|
|
CELL *max = ArenaLimit(arena);
|
|
|
|
CELL *base = ArenaPt(arena);
|
|
|
|
CELL *newH;
|
|
|
|
UInt old_sz = ArenaSz(arena), new_size;
|
|
|
|
|
|
|
|
if (IN_BETWEEN(base, HR, max)) {
|
|
|
|
base = HR;
|
|
|
|
HR += cells;
|
2010-03-08 09:21:48 +00:00
|
|
|
return base;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
if (base + cells > max - 1024) {
|
|
|
|
if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024,
|
|
|
|
arity PASS_REGS))
|
|
|
|
return NULL;
|
|
|
|
goto restart;
|
|
|
|
}
|
|
|
|
|
|
|
|
newH = base + cells;
|
|
|
|
new_size = old_sz - cells;
|
|
|
|
*arenap = CreateNewArena(newH, new_size);
|
|
|
|
return base;
|
|
|
|
}
|
2010-03-08 09:21:48 +00:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP,
|
|
|
|
UInt old_size USES_REGS) {
|
2006-08-22 17:12:46 +01:00
|
|
|
UInt new_size;
|
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
if (HR == oldH)
|
2006-08-22 17:12:46 +01:00
|
|
|
return;
|
2015-10-20 08:13:09 +01:00
|
|
|
new_size = old_size - (HR - RepAppl(*oldArenaP));
|
2014-01-19 21:15:05 +00:00
|
|
|
*oldArenaP = CreateNewArena(HR, new_size);
|
|
|
|
HR = oldH;
|
2006-08-22 17:12:46 +01:00
|
|
|
HB = oldHB;
|
|
|
|
ASP = oldASP;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
|
2006-08-22 17:12:46 +01:00
|
|
|
if (TR != TR0) {
|
|
|
|
tr_fr_ptr pt = TR0;
|
|
|
|
|
|
|
|
do {
|
|
|
|
Term p = TrailTerm(pt++);
|
|
|
|
if (IsVarTerm(p)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
RESET_VARIABLE(p);
|
2006-08-22 17:12:46 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
/* copy downwards */
|
|
|
|
TrailTerm(TR0 + 1) = TrailTerm(pt);
|
|
|
|
TrailTerm(TR0) = TrailTerm(TR0 + 2) = p;
|
|
|
|
pt += 2;
|
|
|
|
TR0 += 3;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
} while (pt != TR);
|
|
|
|
TR = TR0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
|
|
|
|
int share, int copy_att_vars, CELL *ptf,
|
|
|
|
CELL *HLow USES_REGS) {
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
struct cp_frame *to_visit0,
|
|
|
|
*to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
|
2006-08-22 17:12:46 +01:00
|
|
|
CELL *HB0 = HB;
|
|
|
|
tr_fr_ptr TR0 = TR;
|
2007-09-21 15:18:12 +01:00
|
|
|
int ground = TRUE;
|
|
|
|
|
2006-08-22 17:12:46 +01:00
|
|
|
HB = HLow;
|
|
|
|
to_visit0 = to_visit;
|
2015-10-20 08:13:09 +01:00
|
|
|
loop:
|
2006-08-22 17:12:46 +01:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
2015-10-20 08:13:09 +01:00
|
|
|
++pt0;
|
2006-08-22 17:12:46 +01:00
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
|
|
|
deref_head(d0, copy_term_unk);
|
2015-10-20 08:13:09 +01:00
|
|
|
copy_term_nvar : {
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
CELL *ap2 = RepPair(d0);
|
|
|
|
if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
*ptf = AbsPair(HR);
|
|
|
|
ptf++;
|
2006-08-22 17:12:46 +01:00
|
|
|
#ifdef RATIONAL_TREES
|
2015-10-20 08:13:09 +01:00
|
|
|
if (to_visit + 1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsPair(HR);
|
|
|
|
to_visit++;
|
2006-08-22 17:12:46 +01:00
|
|
|
#else
|
2015-10-20 08:13:09 +01:00
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
if (to_visit + 1 >= (CELL **)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
to_visit++;
|
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
#endif
|
2015-10-20 08:13:09 +01:00
|
|
|
ground = TRUE;
|
|
|
|
pt0 = ap2 - 1;
|
|
|
|
pt0_end = ap2 + 1;
|
|
|
|
ptf = HR;
|
|
|
|
HR += 2;
|
|
|
|
if (HR > ASP - MIN_ARENA_SIZE) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2;
|
|
|
|
/* store the terms to visit */
|
|
|
|
ap2 = RepAppl(d0);
|
|
|
|
if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
f = (Functor)(*ap2);
|
|
|
|
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
switch ((CELL)f) {
|
|
|
|
case (CELL) FunctorDBRef:
|
|
|
|
case (CELL) FunctorAttVar:
|
|
|
|
*ptf++ = d0;
|
|
|
|
break;
|
|
|
|
case (CELL) FunctorLongInt:
|
|
|
|
if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
*ptf++ = AbsAppl(HR);
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
HR[1] = ap2[1];
|
|
|
|
HR[2] = EndSpecials;
|
|
|
|
HR += 3;
|
|
|
|
if (HR > ASP - MIN_ARENA_SIZE) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
break;
|
|
|
|
case (CELL) FunctorDouble:
|
|
|
|
if (HR >
|
|
|
|
ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
*ptf++ = AbsAppl(HR);
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
HR[1] = ap2[1];
|
|
|
|
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
|
|
|
|
HR[2] = ap2[2];
|
|
|
|
HR[3] = EndSpecials;
|
|
|
|
HR += 4;
|
2006-09-01 21:14:42 +01:00
|
|
|
#else
|
2015-10-20 08:13:09 +01:00
|
|
|
HR[2] = EndSpecials;
|
|
|
|
HR += 3;
|
2006-09-01 21:14:42 +01:00
|
|
|
#endif
|
2015-10-20 08:13:09 +01:00
|
|
|
break;
|
|
|
|
case (CELL) FunctorString:
|
|
|
|
if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
*ptf++ = AbsAppl(HR);
|
|
|
|
memcpy(HR, ap2, sizeof(CELL) * (3 + ap2[1]));
|
|
|
|
HR += ap2[1] + 3;
|
|
|
|
break;
|
|
|
|
default: {
|
|
|
|
/* big int */
|
|
|
|
UInt sz = (sizeof(MP_INT) + 3 * CellSize +
|
|
|
|
((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) /
|
|
|
|
CellSize,
|
|
|
|
i;
|
|
|
|
|
|
|
|
if (HR > ASP - (MIN_ARENA_SIZE + sz)) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
*ptf++ = AbsAppl(HR);
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
for (i = 1; i < sz; i++) {
|
|
|
|
HR[i] = ap2[i];
|
|
|
|
}
|
|
|
|
HR += sz;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
*ptf = AbsAppl(HR);
|
|
|
|
ptf++;
|
|
|
|
/* store the terms to visit */
|
2006-08-22 17:12:46 +01:00
|
|
|
#ifdef RATIONAL_TREES
|
2015-10-20 08:13:09 +01:00
|
|
|
if (to_visit + 1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsAppl(HR);
|
|
|
|
to_visit++;
|
2006-08-22 17:12:46 +01:00
|
|
|
#else
|
2015-10-20 08:13:09 +01:00
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
if (to_visit++ >= (CELL **)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
to_visit++;
|
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
#endif
|
2015-10-20 08:13:09 +01:00
|
|
|
ground = (f != FunctorMutable);
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
/* store the functor for the new term */
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
ptf = HR + 1;
|
|
|
|
HR += 1 + d0;
|
|
|
|
if (HR > ASP - MIN_ARENA_SIZE) {
|
|
|
|
goto overflow;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
} else {
|
|
|
|
/* just copy atoms or integers */
|
|
|
|
*ptf++ = d0;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
continue;
|
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
|
|
|
|
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
|
2007-09-21 15:18:12 +01:00
|
|
|
ground = FALSE;
|
|
|
|
/* don't need to copy variables if we want to share the global term */
|
2015-10-20 08:13:09 +01:00
|
|
|
if ((share && ptd0 < HB && ptd0 > H0) || (ptd0 >= HLow && ptd0 < HR)) {
|
2006-08-22 17:12:46 +01:00
|
|
|
/* we have already found this cell */
|
2015-10-20 08:13:09 +01:00
|
|
|
*ptf++ = (CELL)ptd0;
|
2006-08-22 17:12:46 +01:00
|
|
|
} else {
|
|
|
|
#if COROUTINING
|
2011-03-19 10:25:23 +00:00
|
|
|
if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
/* if unbound, call the standard copy term routine */
|
|
|
|
struct cp_frame *bp;
|
|
|
|
CELL new;
|
|
|
|
|
|
|
|
bp = to_visit;
|
|
|
|
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
|
|
|
|
ptf PASS_REGS)) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
to_visit = bp;
|
|
|
|
new = *ptf;
|
|
|
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
|
|
|
/* Trail overflow */
|
|
|
|
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
|
|
|
|
goto trail_overflow;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
Bind_and_Trail(ptd0, new);
|
|
|
|
ptf++;
|
2010-03-08 09:21:48 +00:00
|
|
|
} else {
|
2010-03-12 08:24:58 +00:00
|
|
|
#endif
|
2015-10-20 08:13:09 +01:00
|
|
|
/* first time we met this term */
|
|
|
|
RESET_VARIABLE(ptf);
|
|
|
|
if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
|
|
|
|
goto trail_overflow;
|
|
|
|
Bind_and_Trail(ptd0, (CELL)ptf);
|
|
|
|
ptf++;
|
2010-03-12 08:24:58 +00:00
|
|
|
#ifdef COROUTINING
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
#endif
|
|
|
|
}
|
|
|
|
}
|
2010-03-12 08:24:58 +00:00
|
|
|
|
2006-08-22 17:12:46 +01:00
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit > to_visit0) {
|
2015-10-20 08:13:09 +01:00
|
|
|
to_visit--;
|
2007-09-21 15:18:12 +01:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
2006-08-22 17:12:46 +01:00
|
|
|
#ifdef RATIONAL_TREES
|
2007-09-21 15:18:12 +01:00
|
|
|
*pt0 = to_visit->oldv;
|
2006-08-22 17:12:46 +01:00
|
|
|
#endif
|
2007-09-21 15:18:12 +01:00
|
|
|
ground = (ground && to_visit->ground);
|
2006-08-22 17:12:46 +01:00
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
2011-03-07 16:02:55 +00:00
|
|
|
clean_dirty_tr(TR0 PASS_REGS);
|
2010-03-15 14:17:30 +00:00
|
|
|
/* follow chain of multi-assigned variables */
|
2006-08-22 17:12:46 +01:00
|
|
|
return 0;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
overflow:
|
2006-08-22 17:12:46 +01:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2006-08-22 17:12:46 +01:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
2015-10-20 08:13:09 +01:00
|
|
|
to_visit--;
|
2007-09-21 15:18:12 +01:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
#endif
|
|
|
|
reset_trail(TR0);
|
|
|
|
return -1;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
heap_overflow:
|
2006-08-22 17:12:46 +01:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2006-08-22 17:12:46 +01:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
2007-09-21 15:18:12 +01:00
|
|
|
to_visit--;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
#endif
|
|
|
|
reset_trail(TR0);
|
|
|
|
return -2;
|
2010-03-12 08:24:58 +00:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
trail_overflow:
|
2010-03-12 08:24:58 +00:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2010-03-12 08:24:58 +00:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
|
|
|
to_visit--;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
reset_trail(TR0);
|
|
|
|
return -4;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
|
|
|
|
UInt arity, Term *newarena,
|
|
|
|
size_t min_grow USES_REGS) {
|
2014-09-10 05:50:43 +01:00
|
|
|
size_t old_size = ArenaSz(arena);
|
2014-01-19 21:15:05 +00:00
|
|
|
CELL *oldH = HR;
|
2006-08-22 17:12:46 +01:00
|
|
|
CELL *oldHB = HB;
|
|
|
|
CELL *oldASP = ASP;
|
2008-10-18 11:03:25 +01:00
|
|
|
int res = 0;
|
2007-09-21 15:18:12 +01:00
|
|
|
Term tn;
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
restart:
|
2006-08-22 17:12:46 +01:00
|
|
|
t = Deref(t);
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
ASP = ArenaLimit(arena);
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2006-08-22 17:12:46 +01:00
|
|
|
#if COROUTINING
|
2011-03-19 10:25:23 +00:00
|
|
|
if (GlobalIsAttachedTerm(t)) {
|
2006-08-22 17:12:46 +01:00
|
|
|
CELL *Hi;
|
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
*HR = t;
|
2015-10-20 08:13:09 +01:00
|
|
|
Hi = HR + 1;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR += 2;
|
2015-10-20 08:13:09 +01:00
|
|
|
if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi,
|
|
|
|
Hi PASS_REGS)) < 0)
|
|
|
|
goto error_handler;
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
return Hi[0];
|
|
|
|
}
|
|
|
|
#endif
|
2007-09-21 15:18:12 +01:00
|
|
|
if (share && VarOfTerm(t) > ArenaPt(arena)) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2007-09-21 15:18:12 +01:00
|
|
|
return t;
|
|
|
|
}
|
|
|
|
tn = MkVarTerm();
|
2014-01-19 21:15:05 +00:00
|
|
|
if (HR > ASP - MIN_ARENA_SIZE) {
|
2006-08-30 02:06:30 +01:00
|
|
|
res = -1;
|
|
|
|
goto error_handler;
|
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
return tn;
|
2006-09-01 21:14:42 +01:00
|
|
|
} else if (IsAtomOrIntTerm(t)) {
|
2006-08-22 17:12:46 +01:00
|
|
|
return t;
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
Term tf;
|
|
|
|
CELL *ap;
|
|
|
|
CELL *Hi;
|
|
|
|
|
2007-09-21 15:18:12 +01:00
|
|
|
if (share && ArenaPt(arena) > RepPair(t)) {
|
|
|
|
return t;
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2006-08-22 17:12:46 +01:00
|
|
|
ASP = ArenaLimit(arena);
|
|
|
|
ap = RepPair(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
Hi = HR;
|
|
|
|
tf = AbsPair(HR);
|
|
|
|
HR += 2;
|
2015-10-20 08:13:09 +01:00
|
|
|
if ((res = copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi,
|
|
|
|
Hi PASS_REGS)) < 0) {
|
|
|
|
goto error_handler;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
return tf;
|
|
|
|
} else {
|
2006-09-01 21:14:42 +01:00
|
|
|
Functor f;
|
2006-08-22 17:12:46 +01:00
|
|
|
Term tf;
|
|
|
|
CELL *HB0;
|
|
|
|
CELL *ap;
|
|
|
|
|
2007-09-21 15:18:12 +01:00
|
|
|
if (share && ArenaPt(arena) > RepAppl(t)) {
|
|
|
|
return t;
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2006-08-22 17:12:46 +01:00
|
|
|
ASP = ArenaLimit(arena);
|
|
|
|
f = FunctorOfTerm(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
HB0 = HR;
|
2006-08-22 17:12:46 +01:00
|
|
|
ap = RepAppl(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
tf = AbsAppl(HR);
|
|
|
|
HR[0] = (CELL)f;
|
2006-09-01 21:14:42 +01:00
|
|
|
if (IsExtensionFunctor(f)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
switch ((CELL)f) {
|
|
|
|
case (CELL) FunctorDBRef:
|
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
|
|
|
return t;
|
|
|
|
case (CELL) FunctorLongInt:
|
|
|
|
if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
|
|
|
|
res = -1;
|
|
|
|
goto error_handler;
|
|
|
|
}
|
|
|
|
HR[1] = ap[1];
|
|
|
|
HR[2] = EndSpecials;
|
|
|
|
HR += 3;
|
|
|
|
break;
|
|
|
|
case (CELL) FunctorDouble:
|
|
|
|
if (HR > ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) {
|
|
|
|
res = -1;
|
|
|
|
goto error_handler;
|
|
|
|
}
|
|
|
|
HR[1] = ap[1];
|
|
|
|
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
|
|
|
|
HR[2] = ap[2];
|
|
|
|
HR[3] = EndSpecials;
|
|
|
|
HR += 4;
|
2006-09-01 21:14:42 +01:00
|
|
|
#else
|
2015-10-20 08:13:09 +01:00
|
|
|
HR[2] = EndSpecials;
|
|
|
|
HR += 3;
|
2006-09-01 21:14:42 +01:00
|
|
|
#endif
|
2015-10-20 08:13:09 +01:00
|
|
|
break;
|
|
|
|
case (CELL) FunctorString:
|
|
|
|
if (HR > ASP - (MIN_ARENA_SIZE + 3 + ap[1])) {
|
|
|
|
res = -1;
|
|
|
|
goto error_handler;
|
|
|
|
}
|
|
|
|
memcpy(HR, ap, sizeof(CELL) * (3 + ap[1]));
|
|
|
|
HR += ap[1] + 3;
|
|
|
|
break;
|
|
|
|
default: {
|
|
|
|
UInt sz = ArenaSz(t), i;
|
|
|
|
|
|
|
|
if (HR > ASP - (MIN_ARENA_SIZE + sz)) {
|
|
|
|
res = -1;
|
|
|
|
goto error_handler;
|
|
|
|
}
|
|
|
|
for (i = 1; i < sz; i++) {
|
|
|
|
HR[i] = ap[i];
|
|
|
|
}
|
|
|
|
HR += sz;
|
|
|
|
}
|
2006-09-01 21:14:42 +01:00
|
|
|
}
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
HR += 1 + ArityOfFunctor(f);
|
|
|
|
if (HR > ASP - MIN_ARENA_SIZE) {
|
|
|
|
res = -1;
|
|
|
|
goto error_handler;
|
|
|
|
}
|
|
|
|
if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share,
|
|
|
|
copy_att_vars, HB0 + 1, HB0 PASS_REGS)) <
|
|
|
|
0) {
|
|
|
|
goto error_handler;
|
2006-09-01 21:14:42 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
return tf;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
error_handler:
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB;
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
XREGS[arity + 1] = t;
|
|
|
|
XREGS[arity + 2] = arena;
|
|
|
|
XREGS[arity + 3] = (CELL)newarena;
|
2006-08-22 17:12:46 +01:00
|
|
|
{
|
|
|
|
CELL *old_top = ArenaLimit(*newarena);
|
|
|
|
ASP = oldASP;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = oldH;
|
2006-08-22 17:12:46 +01:00
|
|
|
HB = oldHB;
|
|
|
|
switch (res) {
|
|
|
|
case -1:
|
2011-05-04 10:11:41 +01:00
|
|
|
if (arena == LOCAL_GlobalArena)
|
2015-10-20 08:13:09 +01:00
|
|
|
LOCAL_GlobalArenaOverflows++;
|
|
|
|
if (!GrowArena(arena, old_top, old_size, min_grow, arity + 3 PASS_REGS)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return 0L;
|
2007-09-17 23:17:49 +01:00
|
|
|
}
|
|
|
|
break;
|
|
|
|
default: /* temporary space overflow */
|
2015-10-20 08:13:09 +01:00
|
|
|
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return 0L;
|
2007-09-17 23:17:49 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2007-09-17 23:17:49 +01:00
|
|
|
oldHB = HB;
|
|
|
|
oldASP = ASP;
|
2015-10-20 08:13:09 +01:00
|
|
|
newarena = (CELL *)XREGS[arity + 3];
|
|
|
|
arena = Deref(XREGS[arity + 2]);
|
|
|
|
t = XREGS[arity + 1];
|
2007-09-17 23:17:49 +01:00
|
|
|
old_size = ArenaSz(arena);
|
|
|
|
goto restart;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity,
|
|
|
|
Term *newarena, Term init USES_REGS) {
|
2007-10-28 01:54:09 +01:00
|
|
|
UInt old_size = ArenaSz(arena);
|
2014-01-19 21:15:05 +00:00
|
|
|
CELL *oldH = HR;
|
2007-10-28 01:54:09 +01:00
|
|
|
CELL *oldHB = HB;
|
|
|
|
CELL *oldASP = ASP;
|
|
|
|
Term tf;
|
|
|
|
CELL *HB0;
|
|
|
|
Functor f = Yap_MkFunctor(Na, Nar);
|
|
|
|
UInt i;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
restart:
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2007-10-28 01:54:09 +01:00
|
|
|
ASP = ArenaLimit(arena);
|
2014-01-19 21:15:05 +00:00
|
|
|
HB0 = HR;
|
|
|
|
tf = AbsAppl(HR);
|
|
|
|
HR[0] = (CELL)f;
|
2015-10-20 08:13:09 +01:00
|
|
|
HR += 1 + ArityOfFunctor(f);
|
|
|
|
if (HR > ASP - MIN_ARENA_SIZE) {
|
2007-10-28 01:54:09 +01:00
|
|
|
/* overflow */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB;
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
XREGS[arity + 1] = arena;
|
|
|
|
XREGS[arity + 2] = (CELL)newarena;
|
2007-10-28 01:54:09 +01:00
|
|
|
{
|
|
|
|
CELL *old_top = ArenaLimit(*newarena);
|
|
|
|
ASP = oldASP;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = oldH;
|
2007-10-28 01:54:09 +01:00
|
|
|
HB = oldHB;
|
2011-05-04 10:11:41 +01:00
|
|
|
if (arena == LOCAL_GlobalArena)
|
2015-10-20 08:13:09 +01:00
|
|
|
LOCAL_GlobalArenaOverflows++;
|
|
|
|
if (!GrowArena(arena, old_top, old_size, Nar * sizeof(CELL),
|
|
|
|
arity + 2 PASS_REGS)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
|
|
|
|
"while creating large global term");
|
|
|
|
return 0L;
|
2007-10-28 01:54:09 +01:00
|
|
|
}
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2007-10-28 01:54:09 +01:00
|
|
|
oldHB = HB;
|
|
|
|
oldASP = ASP;
|
2015-10-20 08:13:09 +01:00
|
|
|
newarena = (CELL *)XREGS[arity + 2];
|
|
|
|
arena = Deref(XREGS[arity + 1]);
|
2007-10-28 01:54:09 +01:00
|
|
|
old_size = ArenaSz(arena);
|
|
|
|
goto restart;
|
2015-10-20 08:13:09 +01:00
|
|
|
}
|
2007-10-28 01:54:09 +01:00
|
|
|
if (init == 0L) {
|
2015-10-20 08:13:09 +01:00
|
|
|
for (i = 1; i <= Nar; i++) {
|
|
|
|
RESET_VARIABLE(HB0 + i);
|
2007-10-28 01:54:09 +01:00
|
|
|
}
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
for (i = 1; i <= Nar; i++) {
|
2007-10-28 01:54:09 +01:00
|
|
|
HB0[i] = init;
|
|
|
|
}
|
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
|
2007-10-28 01:54:09 +01:00
|
|
|
return tf;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
inline static GlobalEntry *FindGlobalEntry(Atom at USES_REGS)
|
2006-08-22 17:12:46 +01:00
|
|
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
|
|
|
{
|
|
|
|
Prop p0;
|
|
|
|
AtomEntry *ae = RepAtom(at);
|
|
|
|
|
|
|
|
READ_LOCK(ae->ARWLock);
|
|
|
|
p0 = ae->PropsOfAE;
|
|
|
|
while (p0) {
|
|
|
|
GlobalEntry *pe = RepGlobalProp(p0);
|
2015-10-20 08:13:09 +01:00
|
|
|
if (pe->KindOfPE == GlobalProperty
|
2006-08-22 17:12:46 +01:00
|
|
|
#if THREADS
|
2015-10-20 08:13:09 +01:00
|
|
|
&& pe->owner_id == worker_id
|
2006-08-22 17:12:46 +01:00
|
|
|
#endif
|
2015-10-20 08:13:09 +01:00
|
|
|
) {
|
2006-08-22 17:12:46 +01:00
|
|
|
READ_UNLOCK(ae->ARWLock);
|
|
|
|
return pe;
|
|
|
|
}
|
|
|
|
p0 = pe->NextOfPE;
|
|
|
|
}
|
|
|
|
READ_UNLOCK(ae->ARWLock);
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS)
|
2006-08-22 17:12:46 +01:00
|
|
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
|
|
|
{
|
|
|
|
Prop p0;
|
|
|
|
AtomEntry *ae = RepAtom(at);
|
|
|
|
GlobalEntry *new;
|
|
|
|
|
|
|
|
WRITE_LOCK(ae->ARWLock);
|
|
|
|
p0 = ae->PropsOfAE;
|
|
|
|
while (p0) {
|
|
|
|
GlobalEntry *pe = RepGlobalProp(p0);
|
2015-10-20 08:13:09 +01:00
|
|
|
if (pe->KindOfPE == GlobalProperty
|
2006-08-22 17:12:46 +01:00
|
|
|
#if THREADS
|
2015-10-20 08:13:09 +01:00
|
|
|
&& pe->owner_id == worker_id
|
2006-08-22 17:12:46 +01:00
|
|
|
#endif
|
2015-10-20 08:13:09 +01:00
|
|
|
) {
|
2006-08-22 17:12:46 +01:00
|
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
|
|
return pe;
|
|
|
|
}
|
|
|
|
p0 = pe->NextOfPE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
new = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*new));
|
2006-08-22 17:12:46 +01:00
|
|
|
INIT_RWLOCK(new->GRWLock);
|
|
|
|
new->KindOfPE = GlobalProperty;
|
|
|
|
#if THREADS
|
2006-10-10 15:08:17 +01:00
|
|
|
new->owner_id = worker_id;
|
2006-08-22 17:12:46 +01:00
|
|
|
#endif
|
2011-05-04 10:11:41 +01:00
|
|
|
new->NextGE = LOCAL_GlobalVariables;
|
|
|
|
LOCAL_GlobalVariables = new;
|
2006-08-22 17:12:46 +01:00
|
|
|
new->AtomOfGE = ae;
|
2011-08-17 19:16:21 +01:00
|
|
|
AddPropToAtom(ae, (PropEntry *)new);
|
2006-08-22 17:12:46 +01:00
|
|
|
RESET_VARIABLE(&new->global);
|
|
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
|
|
return new;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static UInt garena_overflow_size(CELL *arena USES_REGS) {
|
|
|
|
UInt dup = (((CELL *)arena - H0) * sizeof(CELL)) >> 3;
|
|
|
|
if (dup < 64 * 1024 * LOCAL_GlobalArenaOverflows)
|
|
|
|
dup = 64 * 1024 * LOCAL_GlobalArenaOverflows;
|
|
|
|
if (dup > 1024 * 1024)
|
|
|
|
return 1024 * 1024;
|
2007-09-17 23:17:49 +01:00
|
|
|
return dup;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_setarg(USES_REGS1) {
|
2007-09-22 09:38:05 +01:00
|
|
|
Term wheret = Deref(ARG1);
|
2012-05-13 10:17:30 +01:00
|
|
|
Term dest;
|
2007-09-22 09:38:05 +01:00
|
|
|
Term to;
|
|
|
|
UInt arity, pos;
|
|
|
|
CELL *destp;
|
|
|
|
|
|
|
|
if (IsVarTerm(wheret)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, wheret, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(wheret)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, wheret, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
}
|
|
|
|
pos = IntegerOfTerm(wheret);
|
2012-05-13 10:17:30 +01:00
|
|
|
dest = Deref(ARG2);
|
2007-09-22 09:38:05 +01:00
|
|
|
if (IsVarTerm(dest)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, dest, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
} else if (IsPrimitiveTerm(dest)) {
|
|
|
|
arity = 0;
|
|
|
|
} else if (IsPairTerm(dest)) {
|
|
|
|
arity = 2;
|
|
|
|
} else {
|
|
|
|
arity = ArityOfFunctor(FunctorOfTerm(dest));
|
|
|
|
}
|
|
|
|
if (pos < 1 || pos > arity)
|
|
|
|
return FALSE;
|
2011-03-30 23:20:25 +01:00
|
|
|
|
|
|
|
to = Deref(ARG3);
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(
|
|
|
|
ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
|
2007-09-17 23:17:49 +01:00
|
|
|
if (to == 0L)
|
|
|
|
return FALSE;
|
2011-03-30 23:20:25 +01:00
|
|
|
|
|
|
|
dest = Deref(ARG2);
|
|
|
|
if (IsPairTerm(dest)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
destp = RepPair(dest) - 1;
|
2011-03-30 23:20:25 +01:00
|
|
|
} else {
|
2012-05-13 10:17:30 +01:00
|
|
|
destp = RepAppl(dest);
|
2011-03-30 23:20:25 +01:00
|
|
|
}
|
2007-09-22 09:38:05 +01:00
|
|
|
destp[pos] = to;
|
|
|
|
return TRUE;
|
2007-09-17 23:17:49 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_set_shared_arg(USES_REGS1) {
|
2007-09-22 09:38:05 +01:00
|
|
|
Term wheret = Deref(ARG1);
|
|
|
|
Term dest = Deref(ARG2);
|
|
|
|
Term to;
|
|
|
|
UInt arity, pos;
|
|
|
|
CELL *destp;
|
|
|
|
|
|
|
|
if (IsVarTerm(wheret)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, wheret, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(wheret)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, wheret, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
}
|
|
|
|
pos = IntegerOfTerm(wheret);
|
|
|
|
if (IsVarTerm(dest)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, dest, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
} else if (IsPrimitiveTerm(dest)) {
|
|
|
|
arity = 0;
|
|
|
|
} else if (IsPairTerm(dest)) {
|
|
|
|
arity = 2;
|
|
|
|
} else {
|
|
|
|
arity = ArityOfFunctor(FunctorOfTerm(dest));
|
|
|
|
}
|
|
|
|
if (pos < 1 || pos > arity)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(
|
|
|
|
ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
|
2007-09-17 23:17:49 +01:00
|
|
|
if (to == 0L)
|
|
|
|
return FALSE;
|
2012-05-13 10:17:30 +01:00
|
|
|
if (IsPairTerm(dest)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
destp = RepPair(dest) - 1;
|
2012-05-13 10:17:30 +01:00
|
|
|
} else {
|
|
|
|
destp = RepAppl(dest);
|
|
|
|
}
|
2007-09-22 09:38:05 +01:00
|
|
|
destp[pos] = to;
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_linkarg(USES_REGS1) {
|
2007-09-22 09:38:05 +01:00
|
|
|
Term wheret = Deref(ARG1);
|
|
|
|
Term dest = Deref(ARG2);
|
|
|
|
UInt arity, pos;
|
|
|
|
CELL *destp;
|
|
|
|
|
|
|
|
if (IsVarTerm(wheret)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, wheret, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(wheret)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, wheret, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
}
|
|
|
|
pos = IntegerOfTerm(wheret);
|
|
|
|
if (IsVarTerm(dest)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, dest, "nb_setarg");
|
|
|
|
return FALSE;
|
2007-09-22 09:38:05 +01:00
|
|
|
} else if (IsPrimitiveTerm(dest)) {
|
|
|
|
arity = 0;
|
|
|
|
destp = NULL;
|
|
|
|
} else if (IsPairTerm(dest)) {
|
|
|
|
arity = 2;
|
2015-10-20 08:13:09 +01:00
|
|
|
destp = RepPair(dest) - 1;
|
2007-09-22 09:38:05 +01:00
|
|
|
} else {
|
|
|
|
arity = ArityOfFunctor(FunctorOfTerm(dest));
|
|
|
|
destp = RepAppl(dest);
|
|
|
|
}
|
|
|
|
if (pos < 1 || pos > arity)
|
|
|
|
return FALSE;
|
|
|
|
destp[pos] = Deref(ARG3);
|
|
|
|
return TRUE;
|
2007-09-17 23:17:49 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_linkval(USES_REGS1) {
|
2007-09-17 23:17:49 +01:00
|
|
|
Term t = Deref(ARG1), to;
|
|
|
|
GlobalEntry *ge;
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_linkval");
|
2007-09-17 23:17:49 +01:00
|
|
|
return (TermNil);
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "nb_linkval");
|
|
|
|
return (FALSE);
|
2007-09-17 23:17:49 +01:00
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
|
2007-09-17 23:17:49 +01:00
|
|
|
to = Deref(ARG2);
|
|
|
|
WRITE_LOCK(ge->GRWLock);
|
2015-10-20 08:13:09 +01:00
|
|
|
ge->global = to;
|
2007-09-17 23:17:49 +01:00
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
|
|
|
return TRUE;
|
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_create_accumulator(USES_REGS1) {
|
2013-06-22 06:26:14 +01:00
|
|
|
Term t = Deref(ARG1), acct, to, t2;
|
2011-04-04 13:20:35 +01:00
|
|
|
CELL *destp;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_create_accumulator");
|
|
|
|
return FALSE;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(t) && !IsBigIntTerm(t) && !IsFloatTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_NUMBER, t, "nb_create_accumulator");
|
|
|
|
return FALSE;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
acct = Yap_MkApplTerm(FunctorGNumber, 1, &t);
|
2011-04-04 13:20:35 +01:00
|
|
|
if (!Yap_unify(ARG2, acct)) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(
|
|
|
|
t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
|
2011-04-04 13:20:35 +01:00
|
|
|
if (to == 0L)
|
|
|
|
return FALSE;
|
2013-06-22 06:26:14 +01:00
|
|
|
t2 = Deref(ARG2);
|
|
|
|
if (IsVarTerm(t2)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(t2, Yap_MkApplTerm(FunctorGNumber, 1, &to));
|
2013-06-22 06:26:14 +01:00
|
|
|
}
|
2011-04-04 13:20:35 +01:00
|
|
|
destp = RepAppl(Deref(ARG2));
|
|
|
|
destp[1] = to;
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_add_to_accumulator(USES_REGS1) {
|
2011-04-04 13:20:35 +01:00
|
|
|
Term t = Deref(ARG1), t0, tadd;
|
|
|
|
Functor f;
|
|
|
|
CELL *destp;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_create_accumulator");
|
|
|
|
return FALSE;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
if (!IsApplTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_NUMBER, t, "nb_accumulator_value");
|
|
|
|
return FALSE;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
f = FunctorOfTerm(t);
|
|
|
|
if (f != FunctorGNumber) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
destp = RepAppl(t);
|
|
|
|
t0 = Deref(destp[1]);
|
|
|
|
tadd = Deref(ARG2);
|
|
|
|
if (IsVarTerm(tadd)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tadd, "nb_create_accumulator");
|
|
|
|
return FALSE;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
if (IsIntegerTerm(t0) && IsIntegerTerm(tadd)) {
|
|
|
|
Int i0 = IntegerOfTerm(t0);
|
|
|
|
Int i1 = IntegerOfTerm(tadd);
|
2015-10-20 08:13:09 +01:00
|
|
|
Term new = MkIntegerTerm(i0 + i1);
|
2011-04-04 13:20:35 +01:00
|
|
|
|
|
|
|
if (IsIntTerm(new)) {
|
|
|
|
/* forget it if it was something else */
|
|
|
|
destp[1] = new;
|
|
|
|
} else {
|
2013-06-22 06:26:14 +01:00
|
|
|
/* long, do we have space or not ?? */
|
2011-04-04 13:20:35 +01:00
|
|
|
if (IsLongIntTerm(t0)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
CELL *target = RepAppl(t0);
|
|
|
|
CELL *source = RepAppl(new);
|
|
|
|
target[1] = source[1];
|
2011-04-04 13:20:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
/* we need to create a new long int */
|
|
|
|
new = CopyTermToArena(
|
|
|
|
new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS)
|
|
|
|
PASS_REGS);
|
|
|
|
destp = RepAppl(Deref(ARG1));
|
|
|
|
destp[1] = new;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
if (IsFloatTerm(t0) && IsFloatTerm(tadd)) {
|
|
|
|
Float f0 = FloatOfTerm(t0);
|
|
|
|
Float f1 = FloatOfTerm(tadd);
|
2015-10-20 08:13:09 +01:00
|
|
|
Term new = MkFloatTerm(f0 + f1);
|
2011-04-04 13:20:35 +01:00
|
|
|
CELL *target = RepAppl(t0);
|
|
|
|
CELL *source = RepAppl(new);
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
|
2011-04-04 13:20:35 +01:00
|
|
|
target[2] = source[2];
|
|
|
|
#endif
|
|
|
|
target[1] = source[1];
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
if (IsNumTerm(t0) && IsNumTerm(tadd)) {
|
|
|
|
Term t2[2], new;
|
|
|
|
t2[0] = t0;
|
|
|
|
t2[1] = tadd;
|
|
|
|
new = Yap_MkApplTerm(FunctorPlus, 2, t2);
|
|
|
|
|
|
|
|
new = Yap_Eval(new);
|
2015-10-20 08:13:09 +01:00
|
|
|
new = CopyTermToArena(
|
|
|
|
new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
|
2011-04-04 13:20:35 +01:00
|
|
|
destp = RepAppl(Deref(ARG1));
|
2015-10-20 08:13:09 +01:00
|
|
|
destp[1] = new;
|
2011-04-04 13:20:35 +01:00
|
|
|
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_accumulator_value(USES_REGS1) {
|
2013-06-22 06:26:14 +01:00
|
|
|
Term t = Deref(ARG1);
|
2011-04-04 13:20:35 +01:00
|
|
|
Functor f;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_accumulator_value");
|
|
|
|
return FALSE;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
if (!IsApplTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_NUMBER, t, "nb_accumulator_value");
|
|
|
|
return FALSE;
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
f = FunctorOfTerm(t);
|
|
|
|
if (f != FunctorGNumber) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ArgOfTerm(1, t), ARG2);
|
2011-04-04 13:20:35 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Term Yap_SetGlobalVal(Atom at, Term t0) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2008-12-29 00:11:05 +00:00
|
|
|
Term to;
|
|
|
|
GlobalEntry *ge;
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = GetGlobalEntry(at PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(
|
|
|
|
t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
|
2008-12-29 00:11:05 +00:00
|
|
|
if (to == 0L)
|
2009-05-17 17:41:59 +01:00
|
|
|
return to;
|
2008-12-29 00:11:05 +00:00
|
|
|
WRITE_LOCK(ge->GRWLock);
|
2015-10-20 08:13:09 +01:00
|
|
|
ge->global = to;
|
2008-12-29 00:11:05 +00:00
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
2009-05-17 17:41:59 +01:00
|
|
|
return to;
|
2008-12-29 00:11:05 +00:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Term Yap_SaveTerm(Term t0) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2009-06-06 00:45:41 +01:00
|
|
|
Term to;
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(
|
|
|
|
t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
|
2009-06-06 00:45:41 +01:00
|
|
|
if (to == 0L)
|
|
|
|
return to;
|
|
|
|
return to;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_setval(USES_REGS1) {
|
2008-12-29 00:11:05 +00:00
|
|
|
Term t = Deref(ARG1);
|
2006-08-22 17:12:46 +01:00
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_setval");
|
2006-08-22 17:12:46 +01:00
|
|
|
return (TermNil);
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "nb_setval");
|
|
|
|
return (FALSE);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2008-12-29 00:11:05 +00:00
|
|
|
return Yap_SetGlobalVal(AtomOfTerm(t), ARG2);
|
2007-09-21 15:18:12 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_set_shared_val(USES_REGS1) {
|
2007-09-21 15:18:12 +01:00
|
|
|
Term t = Deref(ARG1), to;
|
|
|
|
GlobalEntry *ge;
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_setval");
|
2007-09-21 15:18:12 +01:00
|
|
|
return (TermNil);
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "nb_setval");
|
|
|
|
return (FALSE);
|
2007-09-21 15:18:12 +01:00
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(
|
|
|
|
ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena,
|
|
|
|
garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
if (to == 0L)
|
|
|
|
return FALSE;
|
|
|
|
WRITE_LOCK(ge->GRWLock);
|
2015-10-20 08:13:09 +01:00
|
|
|
ge->global = to;
|
2006-08-22 17:12:46 +01:00
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_b_setval(USES_REGS1) {
|
2006-08-22 17:12:46 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
GlobalEntry *ge;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "b_setval");
|
2006-08-22 17:12:46 +01:00
|
|
|
return (TermNil);
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "b_setval");
|
|
|
|
return (FALSE);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
WRITE_LOCK(ge->GRWLock);
|
|
|
|
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
|
|
|
/* the evil deed is to be done now */
|
2009-04-29 14:21:52 +01:00
|
|
|
{
|
|
|
|
/* but first make sure we are doing on a global object, or a constant! */
|
|
|
|
Term t = Deref(ARG2);
|
2014-01-19 21:15:05 +00:00
|
|
|
if (IsVarTerm(t) && VarOfTerm(t) > HR && VarOfTerm(t) < LCL0) {
|
2009-04-29 14:21:52 +01:00
|
|
|
Term tn = MkVarTerm();
|
|
|
|
Bind_Local(VarOfTerm(t), tn);
|
|
|
|
t = tn;
|
|
|
|
}
|
|
|
|
MaBind(&ge->global, t);
|
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
|
|
|
return TRUE;
|
|
|
|
#else
|
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(SYSTEM_ERROR_INTERNAL, t, "update_array");
|
2006-08-22 17:12:46 +01:00
|
|
|
return FALSE;
|
|
|
|
#endif
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static int undefined_global(USES_REGS1) {
|
2014-10-12 11:02:47 +01:00
|
|
|
Term t3 = Deref(ARG3);
|
|
|
|
|
|
|
|
if (IsApplTerm(t3)) {
|
|
|
|
if (FunctorOfTerm(t3) == FunctorEq)
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ArgOfTerm(1, t3), ArgOfTerm(2, t3));
|
2014-10-12 11:02:47 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
return Yap_unify(t3, TermNil);
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_getval(USES_REGS1) {
|
2006-08-22 17:12:46 +01:00
|
|
|
Term t = Deref(ARG1), to;
|
|
|
|
GlobalEntry *ge;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_getval");
|
2006-08-22 17:12:46 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "nb_getval");
|
2006-08-22 17:12:46 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = FindGlobalEntry(AtomOfTerm(t) PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
if (!ge)
|
|
|
|
return undefined_global(PASS_REGS1);
|
2006-08-22 17:12:46 +01:00
|
|
|
READ_LOCK(ge->GRWLock);
|
|
|
|
to = ge->global;
|
2007-10-18 09:24:16 +01:00
|
|
|
if (IsVarTerm(to) && IsUnboundVar(VarOfTerm(to))) {
|
2007-10-18 10:13:50 +01:00
|
|
|
Term t = MkVarTerm();
|
2014-05-29 10:32:28 +01:00
|
|
|
YapBind(VarOfTerm(to), t);
|
2007-10-18 10:13:50 +01:00
|
|
|
to = t;
|
2007-10-18 09:24:16 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
READ_UNLOCK(ge->GRWLock);
|
2014-10-12 11:02:47 +01:00
|
|
|
if (to == TermFoundVar) {
|
2009-05-17 18:38:39 +01:00
|
|
|
return FALSE;
|
2014-10-12 11:02:47 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
return Yap_unify(ARG2, to);
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Term Yap_GetGlobal(Atom at) {
|
2015-07-23 01:12:32 +01:00
|
|
|
CACHE_REGS
|
|
|
|
GlobalEntry *ge;
|
|
|
|
Term to;
|
2015-10-20 08:13:09 +01:00
|
|
|
|
2015-07-23 01:12:32 +01:00
|
|
|
ge = FindGlobalEntry(at PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
if (!ge)
|
2015-07-23 01:12:32 +01:00
|
|
|
return 0L;
|
|
|
|
READ_LOCK(ge->GRWLock);
|
|
|
|
to = ge->global;
|
|
|
|
if (IsVarTerm(to) && IsUnboundVar(VarOfTerm(to))) {
|
|
|
|
Term t = MkVarTerm();
|
|
|
|
YapBind(VarOfTerm(to), t);
|
|
|
|
to = t;
|
|
|
|
}
|
|
|
|
READ_UNLOCK(ge->GRWLock);
|
|
|
|
if (to == TermFoundVar) {
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
return to;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int nbdelete(Atom at USES_REGS) {
|
2006-08-22 17:12:46 +01:00
|
|
|
GlobalEntry *ge, *g;
|
|
|
|
AtomEntry *ae;
|
|
|
|
Prop gp, g0;
|
|
|
|
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = FindGlobalEntry(at PASS_REGS);
|
2010-02-28 00:57:29 +00:00
|
|
|
if (!ge) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(EXISTENCE_ERROR_VARIABLE, MkAtomTerm(at), "nb_delete");
|
2006-08-22 17:12:46 +01:00
|
|
|
return FALSE;
|
2010-02-28 00:57:29 +00:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
WRITE_LOCK(ge->GRWLock);
|
|
|
|
ae = ge->AtomOfGE;
|
2011-05-04 10:11:41 +01:00
|
|
|
if (LOCAL_GlobalVariables == ge) {
|
|
|
|
LOCAL_GlobalVariables = ge->NextGE;
|
2006-08-22 17:12:46 +01:00
|
|
|
} else {
|
2011-05-04 10:11:41 +01:00
|
|
|
g = LOCAL_GlobalVariables;
|
2015-10-20 08:13:09 +01:00
|
|
|
while (g->NextGE != ge)
|
2006-08-22 17:12:46 +01:00
|
|
|
g = g->NextGE;
|
|
|
|
g->NextGE = ge->NextGE;
|
|
|
|
}
|
|
|
|
gp = AbsGlobalProp(ge);
|
|
|
|
WRITE_LOCK(ae->ARWLock);
|
|
|
|
if (ae->PropsOfAE == gp) {
|
|
|
|
ae->PropsOfAE = ge->NextOfPE;
|
|
|
|
} else {
|
|
|
|
g0 = ae->PropsOfAE;
|
2015-10-20 08:13:09 +01:00
|
|
|
while (g0->NextOfPE != gp)
|
2006-08-22 17:12:46 +01:00
|
|
|
g0 = g0->NextOfPE;
|
|
|
|
g0->NextOfPE = ge->NextOfPE;
|
|
|
|
}
|
|
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
|
|
|
Yap_FreeCodeSpace((char *)ge);
|
2007-02-21 16:50:51 +00:00
|
|
|
return TRUE;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Int Yap_DeleteGlobal(Atom at) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
|
|
|
return nbdelete(at PASS_REGS);
|
2009-11-27 11:21:24 +00:00
|
|
|
}
|
|
|
|
|
2015-11-18 15:06:25 +00:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_delete(USES_REGS1) {
|
2009-11-27 11:21:24 +00:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_delete");
|
2009-11-27 11:21:24 +00:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "nb_delete");
|
2009-11-27 11:21:24 +00:00
|
|
|
return FALSE;
|
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
return nbdelete(AtomOfTerm(t) PASS_REGS);
|
2009-11-27 11:21:24 +00:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_create(USES_REGS1) {
|
2007-10-28 01:54:09 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
Term tname = Deref(ARG2);
|
|
|
|
Term tarity = Deref(ARG3);
|
|
|
|
Term to;
|
|
|
|
GlobalEntry *ge;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
|
2010-02-28 00:57:29 +00:00
|
|
|
if (!ge) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(EXISTENCE_ERROR_VARIABLE, t, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
2010-02-28 00:57:29 +00:00
|
|
|
}
|
2007-10-28 01:54:09 +01:00
|
|
|
if (IsVarTerm(tarity)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tarity, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsIntegerTerm(tarity)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, tarity, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
if (IsVarTerm(tname)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsAtomTerm(tname)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CreateTermInArena(LOCAL_GlobalArena, AtomOfTerm(tname),
|
|
|
|
IntegerOfTerm(tarity), 3, &LOCAL_GlobalArena,
|
|
|
|
0L PASS_REGS);
|
2007-10-28 01:54:09 +01:00
|
|
|
if (!to)
|
|
|
|
return FALSE;
|
|
|
|
WRITE_LOCK(ge->GRWLock);
|
2015-10-20 08:13:09 +01:00
|
|
|
ge->global = to;
|
2007-10-28 01:54:09 +01:00
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_create2(USES_REGS1) {
|
2007-10-28 01:54:09 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
Term tname = Deref(ARG2);
|
|
|
|
Term tarity = Deref(ARG3);
|
|
|
|
Term tinit = Deref(ARG4);
|
|
|
|
Term to;
|
|
|
|
GlobalEntry *ge;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsAtomTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
|
2010-02-28 00:57:29 +00:00
|
|
|
if (!ge) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(EXISTENCE_ERROR_VARIABLE, t, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
2010-02-28 00:57:29 +00:00
|
|
|
}
|
2007-10-28 01:54:09 +01:00
|
|
|
if (IsVarTerm(tarity)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tarity, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsIntegerTerm(tarity)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, tarity, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
if (IsVarTerm(tname)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsAtomTerm(tname)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
if (IsVarTerm(tinit)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tname, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
} else if (!IsAtomTerm(tinit)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, tname, "nb_create");
|
2007-10-28 01:54:09 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CreateTermInArena(LOCAL_GlobalArena, AtomOfTerm(tname),
|
|
|
|
IntegerOfTerm(tarity), 4, &LOCAL_GlobalArena,
|
|
|
|
tinit PASS_REGS);
|
2007-10-28 01:54:09 +01:00
|
|
|
if (!to)
|
|
|
|
return FALSE;
|
|
|
|
WRITE_LOCK(ge->GRWLock);
|
2015-10-20 08:13:09 +01:00
|
|
|
ge->global = to;
|
2007-10-28 01:54:09 +01:00
|
|
|
WRITE_UNLOCK(ge->GRWLock);
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-11-18 15:06:25 +00:00
|
|
|
|
|
|
|
/// @{
|
|
|
|
|
|
|
|
/// @addtogroup nb
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
/* a non-backtrackable queue is a term of the form $array(Arena,Start,End,Size)
|
|
|
|
* plus an Arena. */
|
2006-08-22 17:12:46 +01:00
|
|
|
|
2015-11-18 15:06:25 +00:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int nb_queue(UInt arena_sz USES_REGS) {
|
2010-03-12 22:40:17 +00:00
|
|
|
Term queue_arena, queue, ar[QUEUE_FUNCTOR_ARITY], *nar;
|
2006-08-22 17:12:46 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
|
2011-05-04 10:11:41 +01:00
|
|
|
LOCAL_DepthArenas++;
|
2006-08-22 17:12:46 +01:00
|
|
|
if (!IsVarTerm(t)) {
|
|
|
|
if (!IsApplTerm(t)) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
return (FunctorOfTerm(t) == FunctorNBQueue);
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
ar[QUEUE_ARENA] = ar[QUEUE_HEAD] = ar[QUEUE_TAIL] = ar[QUEUE_SIZE] =
|
|
|
|
MkIntTerm(0);
|
|
|
|
queue = Yap_MkApplTerm(FunctorNBQueue, QUEUE_FUNCTOR_ARITY, ar);
|
|
|
|
if (!Yap_unify(queue, ARG1))
|
2006-08-22 17:12:46 +01:00
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
if (arena_sz < 4 * 1024)
|
|
|
|
arena_sz = 4 * 1024;
|
2014-10-13 12:34:52 +01:00
|
|
|
queue_arena = NewArena(arena_sz, worker_id, 1, NULL);
|
2006-09-01 21:14:42 +01:00
|
|
|
if (queue_arena == 0L) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
nar = RepAppl(Deref(ARG1)) + 1;
|
2006-09-01 21:14:42 +01:00
|
|
|
nar[QUEUE_ARENA] = queue_arena;
|
2006-08-22 17:12:46 +01:00
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue(USES_REGS1) {
|
|
|
|
UInt arena_sz = (ASP - HR) / 16;
|
2011-05-04 10:11:41 +01:00
|
|
|
if (LOCAL_DepthArenas > 1)
|
|
|
|
arena_sz /= LOCAL_DepthArenas;
|
2009-02-27 22:22:49 +00:00
|
|
|
if (arena_sz < MIN_ARENA_SIZE)
|
|
|
|
arena_sz = MIN_ARENA_SIZE;
|
|
|
|
if (arena_sz > MAX_ARENA_SIZE)
|
|
|
|
arena_sz = MAX_ARENA_SIZE;
|
2011-03-07 16:02:55 +00:00
|
|
|
return nb_queue(arena_sz PASS_REGS);
|
2009-02-27 22:22:49 +00:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_sized(USES_REGS1) {
|
2009-02-27 22:22:49 +00:00
|
|
|
Term t = Deref(ARG2);
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "nb_queue");
|
2009-02-27 22:22:49 +00:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, t, "nb_queue");
|
|
|
|
return FALSE;
|
2009-02-27 22:22:49 +00:00
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
return nb_queue((UInt)IntegerOfTerm(t) PASS_REGS);
|
2009-02-27 22:22:49 +00:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static CELL *GetQueue(Term t, char *caller) {
|
2006-08-22 17:12:46 +01:00
|
|
|
t = Deref(t);
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, caller);
|
2006-08-22 17:12:46 +01:00
|
|
|
return NULL;
|
2015-10-20 08:13:09 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
if (!IsApplTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_COMPOUND, t, caller);
|
|
|
|
return NULL;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
if (FunctorOfTerm(t) != FunctorNBQueue) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, t, caller);
|
|
|
|
return NULL;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
return RepAppl(t) + 1;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Term GetQueueArena(CELL *qd, char *caller) {
|
2006-08-22 17:12:46 +01:00
|
|
|
Term t = Deref(qd[QUEUE_ARENA]);
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, caller);
|
2006-08-22 17:12:46 +01:00
|
|
|
return 0L;
|
2015-10-20 08:13:09 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
if (!IsApplTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_COMPOUND, t, caller);
|
|
|
|
return 0L;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
if (FunctorOfTerm(t) != FunctorBigInt) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, t, caller);
|
|
|
|
return 0L;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
return t;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static void RecoverArena(Term arena USES_REGS) {
|
|
|
|
CELL *pt = ArenaPt(arena), *max = ArenaLimit(arena);
|
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
if (max == HR) {
|
|
|
|
HR = pt;
|
2009-06-22 21:37:17 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_close(USES_REGS1) {
|
2006-08-22 17:12:46 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
Int out;
|
|
|
|
|
2011-05-04 10:11:41 +01:00
|
|
|
LOCAL_DepthArenas--;
|
2006-08-22 17:12:46 +01:00
|
|
|
if (!IsVarTerm(t)) {
|
|
|
|
CELL *qp;
|
|
|
|
|
|
|
|
qp = GetQueue(t, "queue/3");
|
|
|
|
if (qp == NULL) {
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ARG3, ARG2);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2006-08-23 13:12:14 +01:00
|
|
|
if (qp[QUEUE_ARENA] != MkIntTerm(0))
|
2011-03-07 16:02:55 +00:00
|
|
|
RecoverArena(qp[QUEUE_ARENA] PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
if (qp[QUEUE_SIZE] == MkIntTerm(0)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ARG3, ARG2);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
out = Yap_unify(ARG3, qp[QUEUE_TAIL]) && Yap_unify(ARG2, qp[QUEUE_HEAD]);
|
2016-11-08 07:37:36 +00:00
|
|
|
RESET_VARIABLE(qp + QUEUE_TAIL);
|
|
|
|
qp[QUEUE_HEAD] = qp[QUEUE_TAIL] = (CELL)(qp + QUEUE_TAIL);
|
2015-10-22 11:53:21 +01:00
|
|
|
qp[QUEUE_SIZE] = MkIntTerm(0);
|
2006-08-22 17:12:46 +01:00
|
|
|
return out;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "queue/3");
|
2006-08-22 17:12:46 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_enqueue(USES_REGS1) {
|
|
|
|
CELL *qd = GetQueue(ARG1, "enqueue"), *oldH, *oldHB;
|
2006-08-22 17:12:46 +01:00
|
|
|
UInt old_sz;
|
|
|
|
Term arena, qsize, to;
|
2006-12-27 18:26:19 +00:00
|
|
|
UInt min_size;
|
2006-08-22 17:12:46 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
arena = GetQueueArena(qd, "enqueue");
|
2006-08-22 17:12:46 +01:00
|
|
|
if (arena == 0L)
|
|
|
|
return FALSE;
|
2006-12-27 18:26:19 +00:00
|
|
|
if (IsPairTerm(qd[QUEUE_HEAD])) {
|
2015-10-20 08:13:09 +01:00
|
|
|
min_size = ArenaPt(arena) - RepPair(qd[QUEUE_HEAD]);
|
2006-12-27 18:26:19 +00:00
|
|
|
} else {
|
|
|
|
min_size = 0L;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd + QUEUE_ARENA,
|
|
|
|
min_size PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
if (to == 0L)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd = GetQueue(ARG1, "enqueue");
|
|
|
|
arena = GetQueueArena(qd, "enqueue");
|
2006-08-22 17:12:46 +01:00
|
|
|
/* garbage collection ? */
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-22 17:12:46 +01:00
|
|
|
oldHB = HB;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2006-08-22 17:12:46 +01:00
|
|
|
old_sz = ArenaSz(arena);
|
|
|
|
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
|
2008-10-29 18:21:41 +00:00
|
|
|
while (old_sz < MIN_ARENA_SIZE) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt gsiz = HR - RepPair(qd[QUEUE_HEAD]);
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = oldH;
|
2006-08-22 17:12:46 +01:00
|
|
|
HB = oldHB;
|
2015-10-20 08:13:09 +01:00
|
|
|
if (gsiz > 1024 * 1024) {
|
|
|
|
gsiz = 1024 * 1024;
|
2006-09-01 21:14:42 +01:00
|
|
|
} else if (gsiz < 1024) {
|
|
|
|
gsiz = 1024;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
ARG3 = to;
|
2007-08-27 23:56:30 +01:00
|
|
|
/* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
|
2011-03-07 16:02:55 +00:00
|
|
|
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) {
|
2015-09-25 10:57:26 +01:00
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
|
2006-08-22 17:12:46 +01:00
|
|
|
return 0L;
|
2015-10-20 08:13:09 +01:00
|
|
|
}
|
2006-08-22 17:12:46 +01:00
|
|
|
to = ARG3;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd = RepAppl(Deref(ARG1)) + 1;
|
|
|
|
arena = GetQueueArena(qd, "enqueue");
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-22 17:12:46 +01:00
|
|
|
oldHB = HB;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2015-10-20 08:13:09 +01:00
|
|
|
old_sz = ArenaSz(arena);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize + 1);
|
2006-08-22 17:12:46 +01:00
|
|
|
if (qsize == 0) {
|
2014-01-19 21:15:05 +00:00
|
|
|
qd[QUEUE_HEAD] = AbsPair(HR);
|
2006-08-22 17:12:46 +01:00
|
|
|
} else {
|
2014-01-19 21:15:05 +00:00
|
|
|
*VarOfTerm(qd[QUEUE_TAIL]) = AbsPair(HR);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
*HR++ = to;
|
|
|
|
RESET_VARIABLE(HR);
|
|
|
|
qd[QUEUE_TAIL] = (CELL)HR;
|
|
|
|
HR++;
|
2015-10-20 08:13:09 +01:00
|
|
|
CloseArena(oldH, oldHB, ASP, qd + QUEUE_ARENA, old_sz PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_dequeue(USES_REGS1) {
|
|
|
|
CELL *qd = GetQueue(ARG1, "dequeue");
|
2006-08-22 17:12:46 +01:00
|
|
|
UInt old_sz, qsz;
|
|
|
|
Term arena, out;
|
|
|
|
CELL *oldH, *oldHB;
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
|
|
|
|
if (qsz == 0)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
arena = GetQueueArena(qd, "dequeue");
|
2006-08-22 17:12:46 +01:00
|
|
|
if (arena == 0L)
|
|
|
|
return FALSE;
|
|
|
|
old_sz = ArenaSz(arena);
|
|
|
|
out = HeadOfTerm(qd[QUEUE_HEAD]);
|
|
|
|
qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]);
|
|
|
|
/* garbage collection ? */
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-22 17:12:46 +01:00
|
|
|
oldHB = HB;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1);
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
|
2006-08-22 17:12:46 +01:00
|
|
|
return Yap_unify(out, ARG2);
|
|
|
|
}
|
|
|
|
|
2011-05-11 09:29:07 +01:00
|
|
|
/* purge an entry from the queue, replacing it by [] */
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_replace(USES_REGS1) {
|
|
|
|
CELL *qd = GetQueue(ARG1, "dequeue");
|
2011-05-11 09:29:07 +01:00
|
|
|
UInt qsz;
|
|
|
|
Term queue, t = Deref(ARG2);
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
|
|
|
|
if (qsz == 0)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
|
2011-05-11 09:29:07 +01:00
|
|
|
queue = qd[QUEUE_HEAD];
|
|
|
|
for (; qsz > 0; qsz--) {
|
|
|
|
if (Yap_eq(HeadOfTerm(queue), t)) {
|
|
|
|
*RepPair(Deref(queue)) = Deref(ARG3);
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
queue = TailOfTerm(queue);
|
|
|
|
}
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_peek(USES_REGS1) {
|
|
|
|
CELL *qd = GetQueue(ARG1, "queue_peek");
|
2006-08-22 17:12:46 +01:00
|
|
|
UInt qsz;
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[QUEUE_SIZE]);
|
|
|
|
if (qsz == 0)
|
|
|
|
return FALSE;
|
|
|
|
return Yap_unify(HeadOfTerm(qd[QUEUE_HEAD]), ARG2);
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_empty(USES_REGS1) {
|
|
|
|
CELL *qd = GetQueue(ARG1, "queue_empty");
|
2006-08-22 17:12:46 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
return (IntegerOfTerm(qd[QUEUE_SIZE]) == 0);
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_size(USES_REGS1) {
|
|
|
|
CELL *qd = GetQueue(ARG1, "queue_size");
|
2006-08-22 17:12:46 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ARG2, qd[QUEUE_SIZE]);
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_queue_show(USES_REGS1) {
|
|
|
|
CELL *qd = GetQueue(ARG1, "queue_size");
|
2011-05-11 09:29:07 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ARG2, qd[QUEUE_HEAD]);
|
2011-05-11 09:29:07 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static CELL *GetHeap(Term t, char *caller) {
|
2006-08-25 20:50:35 +01:00
|
|
|
t = Deref(t);
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, caller);
|
2006-08-25 20:50:35 +01:00
|
|
|
return NULL;
|
2015-10-20 08:13:09 +01:00
|
|
|
}
|
2006-08-25 20:50:35 +01:00
|
|
|
if (!IsApplTerm(t)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_COMPOUND, t, caller);
|
|
|
|
return NULL;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
return RepAppl(t) + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Term MkZeroApplTerm(Functor f, UInt sz USES_REGS) {
|
2006-09-01 21:14:42 +01:00
|
|
|
Term t0, tf;
|
|
|
|
CELL *pt;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
if (HR + (sz + 1) > ASP - 1024)
|
2006-09-01 21:14:42 +01:00
|
|
|
return TermNil;
|
2014-01-19 21:15:05 +00:00
|
|
|
tf = AbsAppl(HR);
|
|
|
|
*HR = (CELL)f;
|
2006-09-01 21:14:42 +01:00
|
|
|
t0 = MkIntTerm(0);
|
2015-10-20 08:13:09 +01:00
|
|
|
pt = HR + 1;
|
2006-09-01 21:14:42 +01:00
|
|
|
while (sz--) {
|
|
|
|
*pt++ = t0;
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = pt;
|
2006-09-01 21:14:42 +01:00
|
|
|
return tf;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_heap(USES_REGS1) {
|
2006-11-14 11:42:26 +00:00
|
|
|
Term heap_arena, heap, *ar, *nar;
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt hsize;
|
|
|
|
Term tsize = Deref(ARG1);
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt arena_sz = (HR - H0) / 16;
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (IsVarTerm(tsize)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tsize, "nb_heap");
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
} else {
|
|
|
|
if (!IsIntegerTerm(tsize)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, tsize, "nb_heap");
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
hsize = IntegerOfTerm(tsize);
|
|
|
|
}
|
2006-09-01 21:14:42 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
while ((heap = MkZeroApplTerm(
|
|
|
|
Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1),
|
|
|
|
2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) {
|
|
|
|
if (!Yap_gcl((2 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) {
|
2015-09-25 10:57:26 +01:00
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
2006-09-01 21:14:42 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
if (!Yap_unify(heap, ARG2))
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
ar = RepAppl(heap) + 1;
|
|
|
|
ar[HEAP_ARENA] = ar[HEAP_SIZE] = MkIntTerm(0);
|
2006-08-25 20:50:35 +01:00
|
|
|
ar[HEAP_MAX] = tsize;
|
|
|
|
if (arena_sz < 1024)
|
|
|
|
arena_sz = 1024;
|
2015-10-20 08:13:09 +01:00
|
|
|
heap_arena = NewArena(arena_sz, worker_id, 1, NULL);
|
2006-08-25 20:50:35 +01:00
|
|
|
if (heap_arena == 0L) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
nar = RepAppl(Deref(ARG2)) + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
nar[HEAP_ARENA] = heap_arena;
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_heap_close(USES_REGS1) {
|
2006-08-25 20:50:35 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
if (!IsVarTerm(t)) {
|
|
|
|
CELL *qp;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
qp = RepAppl(t) + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
if (qp[HEAP_ARENA] != MkIntTerm(0))
|
2011-03-07 16:02:55 +00:00
|
|
|
RecoverArena(qp[HEAP_ARENA] PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
qp[-1] = (CELL)Yap_MkFunctor(AtomHeap, 1);
|
2006-08-30 02:06:30 +01:00
|
|
|
qp[0] = MkIntegerTerm(0);
|
2006-08-25 20:50:35 +01:00
|
|
|
return TRUE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, t, "heap_close/1");
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static void PushHeap(CELL *pt, UInt off) {
|
2006-08-25 20:50:35 +01:00
|
|
|
while (off) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt noff = (off + 1) / 2 - 1;
|
|
|
|
if (Yap_compare_terms(pt[2 * off], pt[2 * noff]) < 0) {
|
|
|
|
Term tk = pt[2 * noff];
|
|
|
|
Term tv = pt[2 * noff + 1];
|
|
|
|
pt[2 * noff] = pt[2 * off];
|
|
|
|
pt[2 * noff + 1] = pt[2 * off + 1];
|
|
|
|
pt[2 * off] = tk;
|
|
|
|
pt[2 * off + 1] = tv;
|
2006-08-25 20:50:35 +01:00
|
|
|
off = noff;
|
|
|
|
} else {
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static void DelHeapRoot(CELL *pt, UInt sz) {
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt indx = 0;
|
|
|
|
Term tk, tv;
|
|
|
|
|
|
|
|
sz--;
|
2015-10-20 08:13:09 +01:00
|
|
|
tk = pt[2 * sz];
|
|
|
|
tv = pt[2 * sz + 1];
|
|
|
|
pt[2 * sz] = TermNil;
|
|
|
|
pt[2 * sz + 1] = TermNil;
|
2006-08-25 20:50:35 +01:00
|
|
|
while (TRUE) {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (sz < 2 * indx + 3 ||
|
|
|
|
Yap_compare_terms(pt[4 * indx + 2], pt[4 * indx + 4]) < 0) {
|
|
|
|
if (sz < 2 * indx + 2 || Yap_compare_terms(tk, pt[4 * indx + 2]) < 0) {
|
|
|
|
pt[2 * indx] = tk;
|
|
|
|
pt[2 * indx + 1] = tv;
|
|
|
|
return;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
pt[2 * indx] = pt[4 * indx + 2];
|
|
|
|
pt[2 * indx + 1] = pt[4 * indx + 3];
|
|
|
|
indx = 2 * indx + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (Yap_compare_terms(tk, pt[4 * indx + 4]) < 0) {
|
|
|
|
pt[2 * indx] = tk;
|
|
|
|
pt[2 * indx + 1] = tv;
|
|
|
|
return;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
pt[2 * indx] = pt[4 * indx + 4];
|
|
|
|
pt[2 * indx + 1] = pt[4 * indx + 5];
|
|
|
|
indx = 2 * indx + 2;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_heap_add_to_heap(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "add_to_heap"), *oldH, *oldHB, *pt;
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt hsize, hmsize, old_sz;
|
|
|
|
Term arena, to, key;
|
2008-06-16 22:22:15 +01:00
|
|
|
UInt mingrow;
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
restart:
|
2006-08-25 20:50:35 +01:00
|
|
|
hsize = IntegerOfTerm(qd[HEAP_SIZE]);
|
|
|
|
hmsize = IntegerOfTerm(qd[HEAP_MAX]);
|
|
|
|
if (hsize == hmsize) {
|
2015-10-20 08:13:09 +01:00
|
|
|
CELL *top = qd + (HEAP_START + 2 * hmsize);
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt extra_size;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
if (hmsize <= 64 * 1024) {
|
|
|
|
extra_size = 64 * 1024;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
|
|
|
extra_size = hmsize;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
if ((extra_size = Yap_InsertInGlobal(top, extra_size * 2 * sizeof(CELL))) ==
|
|
|
|
0) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
|
|
|
|
"No Stack Space for Non-Backtrackable terms");
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
extra_size = extra_size / (2 * sizeof(CELL));
|
|
|
|
qd = GetHeap(ARG1, "add_to_heap");
|
2006-08-25 20:50:35 +01:00
|
|
|
hmsize += extra_size;
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd[-1] = (CELL)Yap_MkFunctor(AtomHeap, 2 * hmsize + HEAP_START);
|
|
|
|
top = qd + (HEAP_START + 2 * (hmsize - extra_size));
|
2006-08-25 20:50:35 +01:00
|
|
|
while (extra_size) {
|
|
|
|
RESET_VARIABLE(top);
|
2015-10-20 08:13:09 +01:00
|
|
|
RESET_VARIABLE(top + 1);
|
|
|
|
top += 2;
|
2006-08-25 20:50:35 +01:00
|
|
|
extra_size--;
|
|
|
|
}
|
|
|
|
arena = qd[HEAP_ARENA];
|
|
|
|
old_sz = ArenaSz(arena);
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-25 20:50:35 +01:00
|
|
|
oldHB = HB;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2006-08-25 20:50:35 +01:00
|
|
|
qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
|
2015-10-20 08:13:09 +01:00
|
|
|
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
|
2006-08-25 20:50:35 +01:00
|
|
|
goto restart;
|
|
|
|
}
|
|
|
|
arena = qd[HEAP_ARENA];
|
|
|
|
if (arena == 0L)
|
|
|
|
return FALSE;
|
2011-03-07 16:02:55 +00:00
|
|
|
mingrow = garena_overflow_size(ArenaPt(arena) PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
ARG2 = CopyTermToArena(ARG2, arena, FALSE, TRUE, 3, qd + HEAP_ARENA,
|
|
|
|
mingrow PASS_REGS);
|
|
|
|
qd = GetHeap(ARG1, "add_to_heap");
|
2006-09-01 21:14:42 +01:00
|
|
|
arena = qd[HEAP_ARENA];
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd + HEAP_ARENA,
|
|
|
|
mingrow PASS_REGS);
|
2010-04-09 18:08:08 +01:00
|
|
|
/* protect key in ARG2 in case there is an overflow while copying to */
|
|
|
|
key = ARG2;
|
2006-08-25 20:50:35 +01:00
|
|
|
if (key == 0 || to == 0L)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd = GetHeap(ARG1, "add_to_heap");
|
2006-08-25 20:50:35 +01:00
|
|
|
arena = qd[HEAP_ARENA];
|
|
|
|
/* garbage collection ? */
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-25 20:50:35 +01:00
|
|
|
oldHB = HB;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2006-08-25 20:50:35 +01:00
|
|
|
old_sz = ArenaSz(arena);
|
2008-10-29 18:21:41 +00:00
|
|
|
while (old_sz < MIN_ARENA_SIZE) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt gsiz = hsize * 2;
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = oldH;
|
2006-08-25 20:50:35 +01:00
|
|
|
HB = oldHB;
|
2015-10-20 08:13:09 +01:00
|
|
|
if (gsiz > 1024 * 1024) {
|
|
|
|
gsiz = 1024 * 1024;
|
2006-09-01 21:14:42 +01:00
|
|
|
} else if (gsiz < 1024) {
|
|
|
|
gsiz = 1024;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
ARG3 = to;
|
2011-03-07 16:02:55 +00:00
|
|
|
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) {
|
2015-09-25 10:57:26 +01:00
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
|
2006-08-25 20:50:35 +01:00
|
|
|
return 0L;
|
2015-10-20 08:13:09 +01:00
|
|
|
}
|
2006-08-25 20:50:35 +01:00
|
|
|
to = ARG3;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd = RepAppl(Deref(ARG1)) + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
arena = qd[HEAP_ARENA];
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-25 20:50:35 +01:00
|
|
|
oldHB = HB;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2015-10-20 08:13:09 +01:00
|
|
|
old_sz = ArenaSz(arena);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
pt = qd + HEAP_START;
|
|
|
|
pt[2 * hsize] = key;
|
|
|
|
pt[2 * hsize + 1] = to;
|
2006-08-25 20:50:35 +01:00
|
|
|
PushHeap(pt, hsize);
|
2015-10-20 08:13:09 +01:00
|
|
|
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
|
|
|
|
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
|
2006-08-25 20:50:35 +01:00
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_heap_del(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "deheap");
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt old_sz, qsz;
|
|
|
|
Term arena;
|
|
|
|
CELL *oldH, *oldHB;
|
|
|
|
Term tk, tv;
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
|
|
|
|
if (qsz == 0)
|
|
|
|
return FALSE;
|
|
|
|
arena = qd[HEAP_ARENA];
|
|
|
|
if (arena == 0L)
|
|
|
|
return FALSE;
|
|
|
|
old_sz = ArenaSz(arena);
|
|
|
|
/* garbage collection ? */
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-25 20:50:35 +01:00
|
|
|
oldHB = HB;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
|
2006-08-25 20:50:35 +01:00
|
|
|
tk = qd[HEAP_START];
|
2015-10-20 08:13:09 +01:00
|
|
|
tv = qd[HEAP_START + 1];
|
|
|
|
DelHeapRoot(qd + HEAP_START, qsz);
|
|
|
|
return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_heap_peek(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "heap_peek");
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt qsz;
|
|
|
|
Term tk, tv;
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
|
|
|
|
if (qsz == 0)
|
|
|
|
return FALSE;
|
|
|
|
tk = qd[HEAP_START];
|
2015-10-20 08:13:09 +01:00
|
|
|
tv = qd[HEAP_START + 1];
|
|
|
|
return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_heap_empty(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "heap_empty");
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
return (IntegerOfTerm(qd[HEAP_SIZE]) == 0);
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_heap_size(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "heap_size");
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ARG2, qd[HEAP_SIZE]);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam(USES_REGS1) {
|
2006-11-14 11:42:26 +00:00
|
|
|
Term beam_arena, beam, *ar, *nar;
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt hsize;
|
|
|
|
Term tsize = Deref(ARG1);
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt arena_sz = (HR - H0) / 16;
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (IsVarTerm(tsize)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(INSTANTIATION_ERROR, tsize, "nb_beam");
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
} else {
|
|
|
|
if (!IsIntegerTerm(tsize)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, tsize, "nb_beam");
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
hsize = IntegerOfTerm(tsize);
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
while ((beam = MkZeroApplTerm(
|
|
|
|
Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1),
|
|
|
|
5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) {
|
|
|
|
if (!Yap_gcl((4 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) {
|
2015-09-25 10:57:26 +01:00
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
2006-09-01 21:14:42 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
if (!Yap_unify(beam, ARG2))
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
ar = RepAppl(beam) + 1;
|
|
|
|
ar[HEAP_ARENA] = ar[HEAP_SIZE] = MkIntTerm(0);
|
2006-08-25 20:50:35 +01:00
|
|
|
ar[HEAP_MAX] = tsize;
|
|
|
|
if (arena_sz < 1024)
|
|
|
|
arena_sz = 1024;
|
2015-10-20 08:13:09 +01:00
|
|
|
beam_arena = NewArena(arena_sz, worker_id, 1, NULL);
|
2006-08-25 20:50:35 +01:00
|
|
|
if (beam_arena == 0L) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
nar = RepAppl(Deref(ARG2)) + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
nar[HEAP_ARENA] = beam_arena;
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_close(USES_REGS1) { return p_nb_heap_close(PASS_REGS1); }
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
/* we have two queues, one with
|
|
|
|
Key, IndxQueue2
|
|
|
|
the other with
|
|
|
|
Key, IndxQueue1, Val
|
|
|
|
*/
|
2015-10-20 08:13:09 +01:00
|
|
|
static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) {
|
2013-03-26 20:01:52 +00:00
|
|
|
CACHE_REGS
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt off = hsize, off2 = hsize;
|
|
|
|
Term toff, toff2;
|
|
|
|
|
|
|
|
/* push into first queue */
|
|
|
|
while (off) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt noff = (off + 1) / 2 - 1;
|
|
|
|
if (Yap_compare_terms(key, pt[2 * noff]) < 0) {
|
|
|
|
UInt i2 = IntegerOfTerm(pt[2 * noff + 1]);
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
pt[2 * off] = pt[2 * noff];
|
|
|
|
pt[2 * off + 1] = pt[2 * noff + 1];
|
|
|
|
npt[3 * i2 + 1] = Global_MkIntegerTerm(off);
|
2006-08-25 20:50:35 +01:00
|
|
|
off = noff;
|
|
|
|
} else {
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
toff = Global_MkIntegerTerm(off);
|
|
|
|
/* off says where we are in first queue */
|
|
|
|
/* push into second queue */
|
|
|
|
while (off2) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt noff = (off2 + 1) / 2 - 1;
|
|
|
|
if (Yap_compare_terms(key, npt[3 * noff]) > 0) {
|
|
|
|
UInt i1 = IntegerOfTerm(npt[3 * noff + 1]);
|
|
|
|
|
|
|
|
npt[3 * off2] = npt[3 * noff];
|
|
|
|
npt[3 * off2 + 1] = npt[3 * noff + 1];
|
|
|
|
npt[3 * off2 + 2] = npt[3 * noff + 2];
|
|
|
|
pt[2 * i1 + 1] = Global_MkIntegerTerm(off2);
|
2006-08-25 20:50:35 +01:00
|
|
|
off2 = noff;
|
|
|
|
} else {
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
toff2 = Global_MkIntegerTerm(off2);
|
|
|
|
/* store elements in their rightful place */
|
2015-10-20 08:13:09 +01:00
|
|
|
npt[3 * off2] = pt[2 * off] = key;
|
|
|
|
pt[2 * off + 1] = toff2;
|
|
|
|
npt[3 * off2 + 1] = toff;
|
|
|
|
npt[3 * off2 + 2] = to;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) {
|
2013-03-26 20:01:52 +00:00
|
|
|
CACHE_REGS
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt off = IntegerOfTerm(pt2[1]);
|
|
|
|
UInt indx = 0;
|
|
|
|
Term tk, ti, tv;
|
|
|
|
|
|
|
|
sz--;
|
|
|
|
/* first, fix the reverse queue */
|
2015-10-20 08:13:09 +01:00
|
|
|
tk = pt2[3 * sz];
|
|
|
|
ti = pt2[3 * sz + 1];
|
|
|
|
tv = pt2[3 * sz + 2];
|
2006-08-25 20:50:35 +01:00
|
|
|
while (TRUE) {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (sz < 2 * indx + 3 ||
|
|
|
|
Yap_compare_terms(pt2[6 * indx + 3], pt2[6 * indx + 6]) > 0) {
|
|
|
|
if (sz < 2 * indx + 2 || Yap_compare_terms(tk, pt2[6 * indx + 3]) > 0) {
|
|
|
|
break;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt off = IntegerOfTerm(pt2[6 * indx + 4]);
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
pt2[3 * indx] = pt2[6 * indx + 3];
|
|
|
|
pt2[3 * indx + 1] = pt2[6 * indx + 4];
|
|
|
|
pt2[3 * indx + 2] = pt2[6 * indx + 5];
|
|
|
|
pt[2 * off + 1] = Global_MkIntegerTerm(indx);
|
|
|
|
indx = 2 * indx + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (Yap_compare_terms(tk, pt2[6 * indx + 6]) > 0) {
|
|
|
|
break;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt off = IntegerOfTerm(pt2[6 * indx + 7]);
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
pt2[3 * indx] = pt2[6 * indx + 6];
|
|
|
|
pt2[3 * indx + 1] = pt2[6 * indx + 7];
|
|
|
|
pt2[3 * indx + 2] = pt2[6 * indx + 8];
|
|
|
|
pt[2 * off + 1] = Global_MkIntegerTerm(indx);
|
|
|
|
indx = 2 * indx + 2;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
pt[2 * IntegerOfTerm(ti) + 1] = Global_MkIntegerTerm(indx);
|
|
|
|
pt2[3 * indx] = tk;
|
|
|
|
pt2[3 * indx + 1] = ti;
|
|
|
|
pt2[3 * indx + 2] = tv;
|
2006-08-25 20:50:35 +01:00
|
|
|
/* now, fix the standard queue */
|
|
|
|
if (off != sz) {
|
|
|
|
Term toff, toff2, key;
|
|
|
|
UInt off2;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
key = pt[2 * sz];
|
|
|
|
toff2 = pt[2 * sz + 1];
|
2006-08-25 20:50:35 +01:00
|
|
|
off2 = IntegerOfTerm(toff2);
|
|
|
|
/* off says where we are in first queue */
|
|
|
|
/* push into second queue */
|
|
|
|
while (off) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt noff = (off + 1) / 2 - 1;
|
|
|
|
if (Yap_compare_terms(key, pt[2 * noff]) < 0) {
|
|
|
|
UInt i1 = IntegerOfTerm(pt[2 * noff + 1]);
|
|
|
|
|
|
|
|
pt[2 * off] = pt[2 * noff];
|
|
|
|
pt[2 * off + 1] = pt[2 * noff + 1];
|
|
|
|
pt2[3 * i1 + 1] = Global_MkIntegerTerm(off);
|
|
|
|
off = noff;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
break;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
toff = Global_MkIntegerTerm(off);
|
|
|
|
/* store elements in their rightful place */
|
2015-10-20 08:13:09 +01:00
|
|
|
pt[2 * off] = key;
|
|
|
|
pt2[3 * off2 + 1] = toff;
|
|
|
|
pt[2 * off + 1] = toff2;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) {
|
2013-03-26 20:01:52 +00:00
|
|
|
CACHE_REGS
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt off2 = IntegerOfTerm(pt[1]);
|
2015-10-20 08:13:09 +01:00
|
|
|
Term ov = pt2[3 * off2 + 2]; /* return value */
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt indx = 0;
|
|
|
|
Term tk, tv;
|
|
|
|
|
|
|
|
sz--;
|
|
|
|
/* first, fix the standard queue */
|
2015-10-20 08:13:09 +01:00
|
|
|
tk = pt[2 * sz];
|
|
|
|
tv = pt[2 * sz + 1];
|
2006-08-25 20:50:35 +01:00
|
|
|
while (TRUE) {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (sz < 2 * indx + 3 ||
|
|
|
|
Yap_compare_terms(pt[4 * indx + 2], pt[4 * indx + 4]) < 0) {
|
|
|
|
if (sz < 2 * indx + 2 || Yap_compare_terms(tk, pt[4 * indx + 2]) < 0) {
|
|
|
|
break;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt off2 = IntegerOfTerm(pt[4 * indx + 3]);
|
|
|
|
pt[2 * indx] = pt[4 * indx + 2];
|
|
|
|
pt[2 * indx + 1] = pt[4 * indx + 3];
|
|
|
|
pt2[3 * off2 + 1] = Global_MkIntegerTerm(indx);
|
|
|
|
indx = 2 * indx + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (Yap_compare_terms(tk, pt[4 * indx + 4]) < 0) {
|
|
|
|
break;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt off2 = IntegerOfTerm(pt[4 * indx + 5]);
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
pt[2 * indx] = pt[4 * indx + 4];
|
|
|
|
pt[2 * indx + 1] = pt[4 * indx + 5];
|
|
|
|
pt2[3 * off2 + 1] = Global_MkIntegerTerm(indx);
|
|
|
|
indx = 2 * indx + 2;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
pt[2 * indx] = tk;
|
|
|
|
pt[2 * indx + 1] = tv;
|
|
|
|
pt2[3 * IntegerOfTerm(tv) + 1] = Global_MkIntegerTerm(indx);
|
2006-08-25 20:50:35 +01:00
|
|
|
/* now, fix the reverse queue */
|
|
|
|
if (off2 != sz) {
|
|
|
|
Term to, toff, toff2, key;
|
|
|
|
UInt off;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
key = pt2[3 * sz];
|
|
|
|
toff = pt2[3 * sz + 1];
|
|
|
|
to = pt2[3 * sz + 2];
|
2006-08-25 20:50:35 +01:00
|
|
|
off = IntegerOfTerm(toff);
|
|
|
|
/* off says where we are in first queue */
|
|
|
|
/* push into second queue */
|
|
|
|
while (off2) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt noff = (off2 + 1) / 2 - 1;
|
|
|
|
if (Yap_compare_terms(key, pt2[3 * noff]) > 0) {
|
|
|
|
UInt i1 = IntegerOfTerm(pt2[3 * noff + 1]);
|
|
|
|
|
|
|
|
pt2[3 * off2] = pt2[3 * noff];
|
|
|
|
pt2[3 * off2 + 1] = pt2[3 * noff + 1];
|
|
|
|
pt2[3 * off2 + 2] = pt2[3 * noff + 2];
|
|
|
|
pt[2 * i1 + 1] = Global_MkIntegerTerm(off2);
|
|
|
|
off2 = noff;
|
2006-08-25 20:50:35 +01:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
break;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
toff2 = Global_MkIntegerTerm(off2);
|
|
|
|
/* store elements in their rightful place */
|
2015-10-20 08:13:09 +01:00
|
|
|
pt2[3 * off2] = key;
|
|
|
|
pt[2 * off + 1] = toff2;
|
|
|
|
pt2[3 * off2 + 1] = toff;
|
|
|
|
pt2[3 * off2 + 2] = to;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
return ov;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_add_to_beam(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "add_to_beam"), *oldH, *oldHB, *pt;
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt hsize, hmsize, old_sz;
|
|
|
|
Term arena, to, key;
|
2008-06-16 22:22:15 +01:00
|
|
|
UInt mingrow;
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
hsize = IntegerOfTerm(qd[HEAP_SIZE]);
|
|
|
|
hmsize = IntegerOfTerm(qd[HEAP_MAX]);
|
|
|
|
key = Deref(ARG2);
|
|
|
|
if (hsize == hmsize) {
|
2015-10-20 08:13:09 +01:00
|
|
|
pt = qd + HEAP_START;
|
|
|
|
if (Yap_compare_terms(pt[2 * hmsize], Deref(ARG2)) > 0) {
|
2006-08-25 20:50:35 +01:00
|
|
|
/* smaller than current max, we need to drop current max */
|
2015-10-20 08:13:09 +01:00
|
|
|
DelBeamMax(pt, pt + 2 * hmsize, hmsize);
|
2006-08-25 20:50:35 +01:00
|
|
|
hsize--;
|
|
|
|
} else {
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
arena = qd[HEAP_ARENA];
|
|
|
|
if (arena == 0L)
|
|
|
|
return FALSE;
|
2011-03-07 16:02:55 +00:00
|
|
|
mingrow = garena_overflow_size(ArenaPt(arena) PASS_REGS);
|
2015-10-20 08:13:09 +01:00
|
|
|
key = CopyTermToArena(ARG2, qd[HEAP_ARENA], FALSE, TRUE, 3, qd + HEAP_ARENA,
|
|
|
|
mingrow PASS_REGS);
|
2006-09-01 21:14:42 +01:00
|
|
|
arena = qd[HEAP_ARENA];
|
2015-10-20 08:13:09 +01:00
|
|
|
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd + HEAP_ARENA,
|
|
|
|
mingrow PASS_REGS);
|
2006-08-25 20:50:35 +01:00
|
|
|
if (key == 0 || to == 0L)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd = GetHeap(ARG1, "add_to_beam");
|
2006-08-25 20:50:35 +01:00
|
|
|
arena = qd[HEAP_ARENA];
|
|
|
|
/* garbage collection ? */
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-25 20:50:35 +01:00
|
|
|
oldHB = HB;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2006-08-25 20:50:35 +01:00
|
|
|
old_sz = ArenaSz(arena);
|
2008-10-29 18:21:41 +00:00
|
|
|
while (old_sz < MIN_ARENA_SIZE) {
|
2015-10-20 08:13:09 +01:00
|
|
|
UInt gsiz = hsize * 2;
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = oldH;
|
2006-08-25 20:50:35 +01:00
|
|
|
HB = oldHB;
|
2015-10-20 08:13:09 +01:00
|
|
|
if (gsiz > 1024 * 1024) {
|
|
|
|
gsiz = 1024 * 1024;
|
2006-09-01 21:14:42 +01:00
|
|
|
} else if (gsiz < 1024) {
|
|
|
|
gsiz = 1024;
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
ARG3 = to;
|
2011-03-07 16:02:55 +00:00
|
|
|
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) {
|
2015-09-25 10:57:26 +01:00
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
|
2006-08-25 20:50:35 +01:00
|
|
|
return 0L;
|
2015-10-20 08:13:09 +01:00
|
|
|
}
|
2006-08-25 20:50:35 +01:00
|
|
|
to = ARG3;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd = RepAppl(Deref(ARG1)) + 1;
|
2006-08-25 20:50:35 +01:00
|
|
|
arena = qd[HEAP_ARENA];
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-25 20:50:35 +01:00
|
|
|
oldHB = HB;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB = ArenaPt(arena);
|
2015-10-20 08:13:09 +01:00
|
|
|
old_sz = ArenaSz(arena);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
pt = qd + HEAP_START;
|
|
|
|
PushBeam(pt, pt + 2 * hmsize, hsize, key, to);
|
|
|
|
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
|
|
|
|
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
|
2006-08-25 20:50:35 +01:00
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_del(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "debeam");
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt old_sz, qsz;
|
|
|
|
Term arena;
|
|
|
|
CELL *oldH, *oldHB;
|
|
|
|
Term tk, tv;
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
|
|
|
|
if (qsz == 0)
|
|
|
|
return FALSE;
|
|
|
|
arena = qd[HEAP_ARENA];
|
|
|
|
if (arena == 0L)
|
|
|
|
return FALSE;
|
|
|
|
old_sz = ArenaSz(arena);
|
|
|
|
/* garbage collection ? */
|
2014-01-19 21:15:05 +00:00
|
|
|
oldH = HR;
|
2006-08-25 20:50:35 +01:00
|
|
|
oldHB = HB;
|
2015-10-20 08:13:09 +01:00
|
|
|
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
|
2011-03-07 16:02:55 +00:00
|
|
|
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
|
2006-08-25 20:50:35 +01:00
|
|
|
tk = qd[HEAP_START];
|
2015-10-20 08:13:09 +01:00
|
|
|
tv = DelBeamMin(qd + HEAP_START,
|
|
|
|
qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz);
|
|
|
|
return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2006-08-30 02:06:30 +01:00
|
|
|
#ifdef DEBUG
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_check(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "debeam");
|
2006-08-25 20:50:35 +01:00
|
|
|
UInt qsz, qmax;
|
|
|
|
CELL *pt, *pt2;
|
|
|
|
UInt i;
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
|
|
|
|
qmax = IntegerOfTerm(qd[HEAP_MAX]);
|
|
|
|
if (qsz == 0)
|
|
|
|
return TRUE;
|
2015-10-20 08:13:09 +01:00
|
|
|
pt = qd + HEAP_START;
|
|
|
|
pt2 = pt + 2 * qmax;
|
2006-08-25 20:50:35 +01:00
|
|
|
for (i = 1; i < qsz; i++) {
|
|
|
|
UInt back;
|
2015-10-20 08:13:09 +01:00
|
|
|
if (Yap_compare_terms(pt[2 * ((i + 1) / 2 - 1)], pt[2 * i]) > 0) {
|
|
|
|
Yap_DebugPlWrite(pt[2 * ((i + 1) / 2 - 1)]);
|
|
|
|
fprintf(stderr, "\n");
|
|
|
|
Yap_DebugPlWrite(pt[2 * i]);
|
|
|
|
fprintf(stderr, "\n");
|
|
|
|
fprintf(stderr, "Error at %ld\n", (unsigned long int)i);
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
2015-10-20 08:13:09 +01:00
|
|
|
back = IntegerOfTerm(pt[2 * i + 1]);
|
|
|
|
if (IntegerOfTerm(pt2[3 * back + 1]) != i) {
|
|
|
|
fprintf(stderr, "Link error at %ld\n", (unsigned long int)i);
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
for (i = 1; i < qsz; i++) {
|
2015-10-20 08:13:09 +01:00
|
|
|
if (Yap_compare_terms(pt2[3 * ((i + 1) / 2 - 1)], pt2[3 * i]) < 0) {
|
|
|
|
fprintf(stderr, "Error at sec %ld\n", (unsigned long int)i);
|
|
|
|
Yap_DebugPlWrite(pt2[3 * ((i + 1) / 2 - 1)]);
|
|
|
|
fprintf(stderr, "\n");
|
|
|
|
Yap_DebugPlWrite(pt2[3 * i]);
|
|
|
|
fprintf(stderr, "\n");
|
2006-08-25 20:50:35 +01:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return TRUE;
|
|
|
|
}
|
2006-09-01 21:14:42 +01:00
|
|
|
|
2006-08-30 02:06:30 +01:00
|
|
|
#endif
|
2006-08-25 20:50:35 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_keys(USES_REGS1) {
|
2006-09-01 21:14:42 +01:00
|
|
|
CELL *qd;
|
|
|
|
UInt qsz;
|
|
|
|
CELL *pt, *ho;
|
|
|
|
UInt i;
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
restart:
|
|
|
|
qd = GetHeap(ARG1, "beam_keys");
|
2006-09-01 21:14:42 +01:00
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
|
2014-01-19 21:15:05 +00:00
|
|
|
ho = HR;
|
2015-10-20 08:13:09 +01:00
|
|
|
pt = qd + HEAP_START;
|
2006-09-01 21:14:42 +01:00
|
|
|
if (qsz == 0)
|
|
|
|
return Yap_unify(ARG2, TermNil);
|
2015-10-20 08:13:09 +01:00
|
|
|
for (i = 0; i < qsz; i++) {
|
|
|
|
if (HR > ASP - 1024) {
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = ho;
|
2015-10-20 08:13:09 +01:00
|
|
|
if (!Yap_gcl(((ASP - HR) - 1024) * sizeof(CELL), 2, ENV, P)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return TermNil;
|
2006-09-01 21:14:42 +01:00
|
|
|
}
|
|
|
|
goto restart;
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
*HR++ = pt[0];
|
2015-10-20 08:13:09 +01:00
|
|
|
*HR = AbsPair(HR + 1);
|
2014-01-19 21:15:05 +00:00
|
|
|
HR++;
|
2006-09-01 21:14:42 +01:00
|
|
|
pt += 2;
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
HR[-1] = TermNil;
|
2006-09-01 21:14:42 +01:00
|
|
|
return Yap_unify(ARG2, AbsPair(ho));
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_peek(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "beam_peek"), *pt, *pt2;
|
2006-08-26 00:22:12 +01:00
|
|
|
UInt qsz, qbsize;
|
2006-08-25 20:50:35 +01:00
|
|
|
Term tk, tv;
|
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
|
2006-08-26 00:22:12 +01:00
|
|
|
qbsize = IntegerOfTerm(qd[HEAP_MAX]);
|
2006-08-25 20:50:35 +01:00
|
|
|
if (qsz == 0)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
pt = qd + HEAP_START;
|
|
|
|
pt2 = pt + 2 * qbsize;
|
2006-08-26 00:22:12 +01:00
|
|
|
tk = pt[0];
|
|
|
|
tv = pt2[2];
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(tk, ARG2) && Yap_unify(tv, ARG3);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_empty(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "beam_empty");
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
|
|
|
return (IntegerOfTerm(qd[HEAP_SIZE]) == 0);
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int p_nb_beam_size(USES_REGS1) {
|
|
|
|
CELL *qd = GetHeap(ARG1, "beam_size");
|
2006-08-25 20:50:35 +01:00
|
|
|
|
|
|
|
if (!qd)
|
|
|
|
return FALSE;
|
2015-10-20 08:13:09 +01:00
|
|
|
return Yap_unify(ARG2, qd[HEAP_SIZE]);
|
2006-08-25 20:50:35 +01:00
|
|
|
}
|
|
|
|
|
2015-11-18 15:06:25 +00:00
|
|
|
/// @}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int cont_current_nb(USES_REGS1) {
|
2007-02-21 16:50:51 +00:00
|
|
|
Int unif;
|
2015-10-20 08:13:09 +01:00
|
|
|
GlobalEntry *ge = (GlobalEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(1, 1));
|
2007-02-21 16:50:51 +00:00
|
|
|
|
|
|
|
unif = Yap_unify(MkAtomTerm(AbsAtom(ge->AtomOfGE)), ARG1);
|
|
|
|
ge = ge->NextGE;
|
|
|
|
if (!ge) {
|
|
|
|
if (unif)
|
|
|
|
cut_succeed();
|
|
|
|
else
|
|
|
|
cut_fail();
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
EXTRA_CBACK_ARG(1, 1) = MkIntegerTerm((Int)ge);
|
2007-02-21 16:50:51 +00:00
|
|
|
return unif;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
static Int init_current_nb(USES_REGS1) { /* current_atom(?Atom) */
|
2007-02-21 16:50:51 +00:00
|
|
|
Term t1 = Deref(ARG1);
|
|
|
|
if (!IsVarTerm(t1)) {
|
2010-03-01 21:48:39 +00:00
|
|
|
if (IsAtomTerm(t1)) {
|
2011-03-07 16:02:55 +00:00
|
|
|
if (!FindGlobalEntry(AtomOfTerm(t1) PASS_REGS)) {
|
2015-10-20 08:13:09 +01:00
|
|
|
cut_fail();
|
2010-03-01 21:48:39 +00:00
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
cut_succeed();
|
2010-03-01 21:48:39 +00:00
|
|
|
}
|
|
|
|
} else {
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_Error(TYPE_ERROR_ATOM, t1, "nb_current");
|
2007-02-21 16:50:51 +00:00
|
|
|
cut_fail();
|
2010-03-01 21:48:39 +00:00
|
|
|
}
|
2007-02-21 16:50:51 +00:00
|
|
|
}
|
|
|
|
READ_LOCK(HashChain[0].AERWLock);
|
2015-10-20 08:13:09 +01:00
|
|
|
EXTRA_CBACK_ARG(1, 1) = MkIntegerTerm((Int)LOCAL_GlobalVariables);
|
|
|
|
return cont_current_nb(PASS_REGS1);
|
2007-02-21 16:50:51 +00:00
|
|
|
}
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
void Yap_InitGlobals(void) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2006-08-25 20:50:35 +01:00
|
|
|
Term cm = CurrentModule;
|
2006-08-22 17:12:46 +01:00
|
|
|
Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0);
|
|
|
|
Yap_InitCPred("arena_size", 1, p_default_arena_size, 0);
|
|
|
|
Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag);
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_InitCPred("__B_setval__", 2, p_b_setval, HiddenPredFlag | SafePredFlag);
|
|
|
|
/** @pred b_setval(+ _Name_, + _Value_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Associate the term _Value_ with the atom _Name_ or replaces
|
|
|
|
the currently associated value with _Value_. If _Name_ does
|
|
|
|
not refer to an existing global variable a variable with initial value
|
|
|
|
[] is created (the empty list). On backtracking the assignment is
|
|
|
|
reversed.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
*/
|
|
|
|
/** @pred b_setval(+ _Name_,+ _Value_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Associate the term _Value_ with the atom _Name_ or replaces
|
|
|
|
the currently associated value with _Value_. If _Name_ does
|
|
|
|
not refer to an existing global variable a variable with initial value
|
|
|
|
`[]` is created (the empty list). On backtracking the
|
|
|
|
assignment is reversed.
|
|
|
|
|
|
|
|
|
|
|
|
*/
|
2006-08-22 17:12:46 +01:00
|
|
|
Yap_InitCPred("nb_setval", 2, p_nb_setval, 0L);
|
2015-09-21 23:05:36 +01:00
|
|
|
Yap_InitCPred("__NB_setval__", 2, p_nb_setval, HiddenPredFlag);
|
2015-10-20 08:13:09 +01:00
|
|
|
/** @pred nb_setval(+ _Name_, + _Value_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Associates a copy of _Value_ created with duplicate_term/2 with
|
|
|
|
the atom _Name_. Note that this can be used to set an initial
|
|
|
|
value other than `[]` prior to backtrackable assignment.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
*/
|
|
|
|
/** @pred nb_setval(+ _Name_,+ _Value_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Associates a copy of _Value_ created with duplicate_term/2
|
|
|
|
with the atom _Name_. Note that this can be used to set an
|
|
|
|
initial value other than `[]` prior to backtrackable assignment.
|
|
|
|
|
|
|
|
|
|
|
|
*/
|
2007-09-21 15:18:12 +01:00
|
|
|
Yap_InitCPred("nb_set_shared_val", 2, p_nb_set_shared_val, 0L);
|
2015-10-20 08:13:09 +01:00
|
|
|
/** @pred nb_set_shared_val(+ _Name_, + _Value_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Associates the term _Value_ with the atom _Name_, but sharing
|
|
|
|
non-backtrackable terms. This may be useful if you want to rewrite a
|
|
|
|
global variable so that the new copy will survive backtracking, but
|
|
|
|
you want to share structure with the previous term.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
The next example shows the differences between the three built-ins:
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
~~~~~
|
|
|
|
?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B).
|
|
|
|
A = a(_A),
|
|
|
|
B = t(_B,a(_C)) ?
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
?-
|
|
|
|
nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B).
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B).
|
|
|
|
A = a(_A),
|
|
|
|
B = t(C,a(_A)) ?
|
|
|
|
~~~~~
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
|
|
|
|
*/
|
2007-09-17 23:17:49 +01:00
|
|
|
Yap_InitCPred("nb_linkval", 2, p_nb_linkval, 0L);
|
2015-10-20 08:13:09 +01:00
|
|
|
/** @pred nb_linkval(+ _Name_, + _Value_)
|
|
|
|
|
|
|
|
|
|
|
|
Associates the term _Value_ with the atom _Name_ without
|
|
|
|
copying it. This is a fast special-purpose variation of nb_setval/2
|
|
|
|
intended for expert users only because the semantics on backtracking
|
|
|
|
to a point before creating the link are poorly defined for compound
|
|
|
|
terms. The principal term is always left untouched, but backtracking
|
|
|
|
behaviour on arguments is undone if the original assignment was
|
|
|
|
trailed and left alone otherwise, which implies that the history that
|
|
|
|
created the term affects the behaviour on backtracking. Please
|
|
|
|
consider the following example:
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
demo_nb_linkval :-
|
|
|
|
T = nice(N),
|
|
|
|
( N = world,
|
|
|
|
nb_linkval(myvar, T),
|
|
|
|
fail
|
|
|
|
; nb_getval(myvar, V),
|
|
|
|
writeln(V)
|
|
|
|
).
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
|
|
|
|
*/
|
2010-03-01 22:32:40 +00:00
|
|
|
Yap_InitCPred("$nb_getval", 3, p_nb_getval, SafePredFlag);
|
2015-09-21 23:05:36 +01:00
|
|
|
Yap_InitCPred("__NB_getval__", 3, p_nb_getval, HiddenPredFlag);
|
|
|
|
Yap_InitCPred("__B_getval__", 3, p_nb_getval, HiddenPredFlag);
|
2007-09-22 09:38:05 +01:00
|
|
|
Yap_InitCPred("nb_setarg", 3, p_nb_setarg, 0L);
|
2015-10-20 08:13:09 +01:00
|
|
|
/** @pred nb_setarg(+{Arg], + _Term_, + _Value_)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Assigns the _Arg_-th argument of the compound term _Term_ with
|
|
|
|
the given _Value_ as setarg/3, but on backtracking the assignment
|
|
|
|
is not reversed. If _Term_ is not atomic, it is duplicated using
|
|
|
|
duplicate_term/2. This predicate uses the same technique as
|
|
|
|
nb_setval/2. We therefore refer to the description of
|
|
|
|
nb_setval/2 for details on non-backtrackable assignment of
|
|
|
|
terms. This predicate is compatible to GNU-Prolog
|
|
|
|
`setarg(A,T,V,false)`, removing the type-restriction on
|
|
|
|
_Value_. See also nb_linkarg/3. Below is an example for
|
|
|
|
counting the number of solutions of a goal. Note that this
|
|
|
|
implementation is thread-safe, reentrant and capable of handling
|
|
|
|
exceptions. Realising these features with a traditional implementation
|
|
|
|
based on assert/retract or flag/3 is much more complicated.
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
succeeds_n_times(Goal, Times) :-
|
|
|
|
Counter = counter(0),
|
|
|
|
( Goal,
|
|
|
|
arg(1, Counter, N0),
|
|
|
|
N is N0 + 1,
|
|
|
|
nb_setarg(1, Counter, N),
|
|
|
|
fail
|
|
|
|
; arg(1, Counter, Times)
|
|
|
|
).
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
|
|
|
|
*/
|
2007-09-22 09:38:05 +01:00
|
|
|
Yap_InitCPred("nb_set_shared_arg", 3, p_nb_set_shared_arg, 0L);
|
2015-10-20 08:13:09 +01:00
|
|
|
/** @pred nb_set_shared_arg(+ _Arg_, + _Term_, + _Value_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
As nb_setarg/3, but like nb_linkval/2 it does not
|
|
|
|
duplicate the global sub-terms in _Value_. Use with extreme care
|
|
|
|
and consult the documentation of nb_linkval/2 before use.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
|
|
|
|
*/
|
2007-09-22 09:38:05 +01:00
|
|
|
Yap_InitCPred("nb_linkarg", 3, p_nb_linkarg, 0L);
|
2015-10-20 08:13:09 +01:00
|
|
|
/** @pred nb_linkarg(+ _Arg_, + _Term_, + _Value_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
As nb_setarg/3, but like nb_linkval/2 it does not
|
|
|
|
duplicate _Value_. Use with extreme care and consult the
|
|
|
|
documentation of nb_linkval/2 before use.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
|
|
|
|
*/
|
2006-08-22 17:12:46 +01:00
|
|
|
Yap_InitCPred("nb_delete", 1, p_nb_delete, 0L);
|
2015-10-20 08:13:09 +01:00
|
|
|
/** @pred nb_delete(+ _Name_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Delete the named global variable.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
Global variables have been introduced by various Prolog
|
|
|
|
implementations recently. We follow the implementation of them in
|
|
|
|
SWI-Prolog, itself based on hProlog by Bart Demoen.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
GNU-Prolog provides a rich set of global variables, including
|
|
|
|
arrays. Arrays can be implemented easily in YAP and SWI-Prolog using
|
|
|
|
functor/3 and `setarg/3` due to the unrestricted arity of
|
|
|
|
compound terms.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2015-10-20 08:13:09 +01:00
|
|
|
@} */
|
2007-10-28 01:54:09 +01:00
|
|
|
Yap_InitCPred("nb_create", 3, p_nb_create, 0L);
|
|
|
|
Yap_InitCPred("nb_create", 4, p_nb_create2, 0L);
|
2015-10-20 08:13:09 +01:00
|
|
|
Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb,
|
|
|
|
SafePredFlag);
|
2015-11-18 15:06:25 +00:00
|
|
|
/// @{
|
|
|
|
/// @addtogroup nb
|
2006-08-25 20:50:35 +01:00
|
|
|
CurrentModule = GLOBALS_MODULE;
|
2006-08-22 17:12:46 +01:00
|
|
|
Yap_InitCPred("nb_queue", 1, p_nb_queue, 0L);
|
2009-02-27 22:22:49 +00:00
|
|
|
Yap_InitCPred("nb_queue", 2, p_nb_queue_sized, 0L);
|
2006-08-22 17:12:46 +01:00
|
|
|
Yap_InitCPred("nb_queue_close", 3, p_nb_queue_close, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_queue_enqueue", 2, p_nb_queue_enqueue, 0L);
|
|
|
|
Yap_InitCPred("nb_queue_dequeue", 2, p_nb_queue_dequeue, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_queue_peek", 2, p_nb_queue_peek, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_queue_empty", 1, p_nb_queue_empty, SafePredFlag);
|
2011-05-11 09:29:07 +01:00
|
|
|
Yap_InitCPred("nb_queue_replace", 3, p_nb_queue_replace, SafePredFlag);
|
2006-08-22 17:12:46 +01:00
|
|
|
Yap_InitCPred("nb_queue_size", 2, p_nb_queue_size, SafePredFlag);
|
2011-05-11 09:29:07 +01:00
|
|
|
Yap_InitCPred("nb_queue_show", 2, p_nb_queue_show, SafePredFlag);
|
2006-08-25 20:50:35 +01:00
|
|
|
Yap_InitCPred("nb_heap", 2, p_nb_heap, 0L);
|
|
|
|
Yap_InitCPred("nb_heap_close", 1, p_nb_heap_close, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_heap_add", 3, p_nb_heap_add_to_heap, 0L);
|
|
|
|
Yap_InitCPred("nb_heap_del", 3, p_nb_heap_del, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_heap_peek", 3, p_nb_heap_peek, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_heap_empty", 1, p_nb_heap_empty, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_heap_size", 2, p_nb_heap_size, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_beam", 2, p_nb_beam, 0L);
|
|
|
|
Yap_InitCPred("nb_beam_close", 1, p_nb_beam_close, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_beam_add", 3, p_nb_beam_add_to_beam, 0L);
|
|
|
|
Yap_InitCPred("nb_beam_del", 3, p_nb_beam_del, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_beam_peek", 3, p_nb_beam_peek, SafePredFlag);
|
|
|
|
Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, SafePredFlag);
|
2006-09-01 21:14:42 +01:00
|
|
|
Yap_InitCPred("nb_beam_keys", 2, p_nb_beam_keys, 0L);
|
2011-04-04 16:23:14 +01:00
|
|
|
Yap_InitCPred("nb_create_accumulator", 2, p_nb_create_accumulator, 0L);
|
|
|
|
Yap_InitCPred("nb_add_to_accumulator", 2, p_nb_add_to_accumulator, 0L);
|
|
|
|
Yap_InitCPred("nb_accumulator_value", 2, p_nb_accumulator_value, 0L);
|
2006-08-30 02:06:30 +01:00
|
|
|
#ifdef DEBUG
|
2006-08-25 20:50:35 +01:00
|
|
|
Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag);
|
2006-08-30 02:06:30 +01:00
|
|
|
#endif
|
2006-08-25 20:50:35 +01:00
|
|
|
Yap_InitCPred("nb_beam_size", 2, p_nb_beam_size, SafePredFlag);
|
2015-11-18 15:06:25 +00:00
|
|
|
/// @}
|
2006-08-25 20:50:35 +01:00
|
|
|
CurrentModule = cm;
|
2006-08-22 17:12:46 +01:00
|
|
|
}
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
/**
|
|
|
|
@}
|
|
|
|
*/
|