/* File: tries.c
** Author(s): Prasad Rao, David S. Warren, Kostis Sagonas,
** Juliana Freire, Baoqiu Cui
** Contact: xsb-contact@cs.sunysb.edu
**
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
** Copyright (C) ECRC, Germany, 1990
**
** XSB is free software; you can redistribute it and/or modify it under the
** terms of the GNU Library General Public License as published by the Free
** Software Foundation; either version 2 of the License, or (at your option)
** any later version.
**
** XSB is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
** FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for
** more details.
**
** You should have received a copy of the GNU Library General Public License
** along with XSB; if not, write to the Free Software Foundation,
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**
** $Id: tries.c,v 1.62 2002/11/05 20:50:38 lfcastro Exp $
**
*/
#include "xsb_config.h"
#include "xsb_debug.h"
#include <stdio.h>
#include <stdlib.h>
/* Special debug includes */
#include "debugs/debug_tries.h"
#include "auxlry.h"
#include "cell_xsb.h"
#include "inst_xsb.h"
#include "psc_xsb.h"
#include "heap_xsb.h"
#include "flags_xsb.h"
#include "deref.h"
#include "memory_xsb.h"
#include "register.h"
#include "binding.h"
#include "trie_internals.h"
#include "macro_xsb.h"
#include "choice.h"
#include "cinterf.h"
#include "error_xsb.h"
#include "tr_utils.h"
#include "debug_xsb.h"
/*----------------------------------------------------------------------*/
extern TIFptr get_tip(Psc);
/*----------------------------------------------------------------------*/
/* The following variables are used in other parts of the system */
/*----------------------------------------------------------------------*/
BTNptr Paren;
long subg_chk_ins, subg_inserts, ans_chk_ins, ans_inserts; /* statistics */
int num_heap_term_vars;
CPtr *var_addr;
int var_addr_arraysz = DEFAULT_ARRAYSIZ;
Cell VarEnumerator[NUM_TRIEVARS];
Cell TrieVarBindings[NUM_TRIEVARS];
xsbBool check_table_cut = TRUE; /* flag for close_open_tables to turn off
cut-over-table check */
/*
* global_num_vars is a new variable to save the value of variable
* num_vars_in_var_regs temporarily.
*/
int global_num_vars;
/*
* Array mini_trail[] is used to trail the variable bindings when we
* copy terms into tries. The variables trailed using mini_trail are
* those that are bound to elements in VarEnumerator[].
*/
static CPtr mini_trail[NUM_TRIEVARS];
static CPtr *mini_trail_top;
/*----------------------------------------------------------------------*/
/* Safe assignment -- can be generalized by type.
CPtr can be abstracted out */
#define safe_assign(ArrayNam,Index,Value,ArraySz) {\
if (Index >= ArraySz) {\
trie_expand_array(CPtr,ArrayNam,ArraySz,"var_addr");\
}\
ArrayNam[Index] = Value;\
}
/*----------------------------------------------------------------------*/
/*****************Addr Stack*************/
static int addr_stack_pointer = 0;
static CPtr *Addr_Stack;
static int addr_stack_size = DEFAULT_ARRAYSIZ;
#define pop_addr Addr_Stack[--addr_stack_pointer]
#define push_addr(X) {\
if (addr_stack_pointer == addr_stack_size) {\
trie_expand_array(CPtr, Addr_Stack ,addr_stack_size,"Addr_Stack");\
}\
Addr_Stack[addr_stack_pointer++] = ((CPtr) X);\
}
/*----------------------------------------------------------------------*/
/*****************Term Stack*************/
static int term_stackptr = -1;
static Cell *term_stack;
static long term_stacksize = DEFAULT_ARRAYSIZ;
#define pop_term term_stack[term_stackptr--]
#define push_term(T) {\
if (term_stackptr+1 == term_stacksize) {\
trie_expand_array(Cell,term_stack,term_stacksize,"term_stack");\
}\
term_stack[++term_stackptr] = ((Cell) T);\
}
/*----------------------------------------------------------------------*/
/*********Simpler trails ****************/
#define simple_table_undo_bindings \
while (mini_trail_top >= mini_trail) { \
untrail(*mini_trail_top); \
mini_trail_top--; \
}
#define StandardizeAndTrailVariable(addr,n) \
StandardizeVariable(addr,n); \
*(++mini_trail_top) = addr;
/*----------------------------------------------------------------------*/
/* Variables used only in this file */
/*----------------------------------------------------------------------*/
static BasicTrieNode dummy_ans_node = {{0,1,0,0},NULL,NULL,NULL,0};
static int AnsVarCtr, ctr, attv_ctr;
static BTNptr *GNodePtrPtr;
/*----------------------------------------------------------------------*/
/*
* T R I E S T R U C T U R E M A N A G E M E N T
* =================================================
*/
/* For Call and Answer Tries
------------------------- */
Structure_Manager smTableBTN = SM_InitDecl(BasicTrieNode, BTNs_PER_BLOCK,
"Basic Trie Node");
Structure_Manager smTableBTHT = SM_InitDecl(BasicTrieHT, BTHTs_PER_BLOCK,
"Basic Trie Hash Table");
Structure_Manager smTSTN = SM_InitDecl(TS_TrieNode, TSTNs_PER_BLOCK,
"Time-Stamped Trie Node");
Structure_Manager smTSTHT = SM_InitDecl(TST_HashTable, TSTHTs_PER_BLOCK,
"Time-Stamped Trie Hash Table");
Structure_Manager smTSIN = SM_InitDecl(TS_IndexNode, TSINs_PER_BLOCK,
"Time-Stamp Indexing Node");
/* For Assert & Intern Tries
------------------------- */
Structure_Manager smAssertBTN = SM_InitDecl(BasicTrieNode, BTNs_PER_BLOCK,
"Basic Trie Node");
Structure_Manager smAssertBTHT = SM_InitDecl(BasicTrieHT, BTHTs_PER_BLOCK,
"Basic Trie Hash Table");
/* Maintains Current Structure Space
--------------------------------- */
Structure_Manager *smBTN = &smTableBTN;
Structure_Manager *smBTHT = &smTableBTHT;
/*----------------------------------------------------------------------*/
void init_trie_aux_areas(void)
{
int i;
alloc_arr(Cell,term_stack,term_stacksize);
alloc_arr(CPtr,var_addr,var_addr_arraysz);
alloc_arr(CPtr,Addr_Stack,addr_stack_size);
alloc_arr(Cell,reg_array,reg_array_size);
reg_arrayptr = reg_array -1;
for (i = 0; i < NUM_TRIEVARS; i++)
VarEnumerator[i] = (Cell) & (VarEnumerator[i]);
}
/*-------------------------------------------------------------------------*/
BTNptr new_btn(int trie_t, int node_t, Cell symbol, BTNptr parent,
BTNptr sibling) {
void *btn;
SM_AllocateStruct(*smBTN,btn);
TN_Init(((BTNptr)btn),trie_t,node_t,symbol,parent,sibling);
return (BTNptr)btn;
}
/*-------------------------------------------------------------------------*/
TSTNptr new_tstn(int trie_t, int node_t, Cell symbol, TSTNptr parent,
TSTNptr sibling) {
void * tstn;
SM_AllocateStruct(smTSTN,tstn);
TN_Init(((TSTNptr)tstn),trie_t,node_t,symbol,parent,sibling);
TSTN_TimeStamp(((TSTNptr)tstn)) = TSTN_DEFAULT_TIMESTAMP;
return (TSTNptr)tstn;
}
/*-------------------------------------------------------------------------*/
/*
* Creates a root node for a given type of trie.
*/
BTNptr newBasicTrie(Cell symbol, int trie_type) {
BTNptr pRoot;
New_BTN( pRoot, trie_type, TRIE_ROOT_NT, symbol, NULL, NULL );
return pRoot;
}
/*----------------------------------------------------------------------*/
/* Used by one_node_chk_ins only. */
#define IsInsibling(wherefrom,count,Found,item,TrieType) \
{ \
LocalNodePtr = wherefrom; \
while (LocalNodePtr && (BTN_Symbol(LocalNodePtr) != item)) { \
LocalNodePtr = BTN_Sibling(LocalNodePtr); \
count++; \
} \
if ( IsNULL(LocalNodePtr) ) { \
Found = 0; \
New_BTN(LocalNodePtr,TrieType,INTERIOR_NT,item,Paren,wherefrom); \
count++; \
wherefrom = LocalNodePtr; /* hook the new node into the trie */ \
} \
Paren = LocalNodePtr; \
}
/*
* Insert/find a single symbol in the trie structure 1-level beneath a
* parent NODE, pointed to by `Paren', whose child link field is
* pointed to by 'GNodePtrPtr'. (If 'Paren' is NULL, then we are most
* likely searching beneath some other structure, like the TIP, and
* 'GNodePtrPtr' points to its "trie root" field.) If the symbol
* cannot be found, create a NODE for this symbol and make it the child
* of `Paren' by setting the field that 'GNodePtrPtr' points to to this
* new NODE. Upon exiting this macro, 'Paren' is set to point to the
* node containing this symbol and 'GNodePtrPtr' gets the address of
* this nodes' Child field.
*
* Algorithm:
* ---------
* If the parent has no children, then create a node for the symbol
* and link it to the parent and vice versa. Set the `Found' flag to
* indicate that a new node was necessary.
*
* Otherwise, if the parent utilizes a hash structure for maintaining
* its children, check to see if there is enough room for one more
* entry. If not, then expand the hash structure. Search for the
* node containing the symbol in question, inserting it if it is not
* found. Signify through `Found' the result of this action.
*
* Otherwise, look for the symbol in a normal chain of children
* beneath the parent. If it is not found, then insert it and check
* to see if the chain has now become too long; if so, then create a
* hash structure for the parent's children. Signify through `Found'
* the result of this action.
*
* Prepare for the next insertion/lookup by changing the `hook' to
* that of the child pointer field of the node which contains the
* just-processed symbol.
*/
#define one_node_chk_ins(Found,item,TrieType) { \
\
int count = 0; \
BTNptr LocalNodePtr; \
\
if ( IsNULL(*GNodePtrPtr) ) { \
New_BTN(LocalNodePtr,TrieType,INTERIOR_NT,item,Paren,NULL); \
*GNodePtrPtr = Paren = LocalNodePtr; \
Found = 0; \
} \
else if ( IsHashHeader(*GNodePtrPtr) ) { \
BTHTptr ht = (BTHTptr)*GNodePtrPtr; \
GNodePtrPtr = CalculateBucketForSymbol(ht,item); \
IsInsibling(*GNodePtrPtr,count,Found,item,TrieType); \
if (!Found) { \
MakeHashedNode(LocalNodePtr); \
BTHT_NumContents(ht)++; \
TrieHT_ExpansionCheck(ht,count); \
} \
} \
else { \
BTNptr pParent = Paren; \
IsInsibling(*GNodePtrPtr,count,Found,item,TrieType); \
if (IsLongSiblingChain(count)) \
/* used to pass in GNodePtrPtr (ptr to hook) */ \
hashify_children(pParent,TrieType); \
} \
GNodePtrPtr = &(BTN_Child(LocalNodePtr)); \
}
/*----------------------------------------------------------------------*/
/* Trie-HashTable maintenance routines.
------------------------------------
parentHook is the address of a field in some structure (should now be
another trie node as all tries now have roots) which points to a chain
of trie nodes whose length has become "too long."
*/
void hashify_children(BTNptr parent, int trieType) {
BTNptr children; /* child list of the parent */
BTNptr btn; /* current child for processing */
BTHTptr ht; /* HT header struct */
BTNptr *tablebase; /* first bucket of allocated HT */
unsigned long hashseed; /* needed for hashing of BTNs */
New_BTHT(ht,trieType);
children = BTN_Child(parent);
BTN_SetHashHdr(parent,ht);
tablebase = BTHT_BucketArray(ht);
hashseed = BTHT_GetHashSeed(ht);
for (btn = children; IsNonNULL(btn); btn = children) {
children = BTN_Sibling(btn);
TrieHT_InsertNode(tablebase, hashseed, btn);
MakeHashedNode(btn);
}
}
/*-------------------------------------------------------------------------*/
/*
* Expand the hash table pointed to by 'pHT'. Note that we can do this
* in place by using realloc() and noticing that, since the hash tables
* and hashing function are based on powers of two, a node existing in
* a bucket will either remain in that bucket -- in the lower part of
* the new table -- or jump to a corresponding bucket in the upper half
* of the expanded table. This function can serve for all types of
* tries since only fields contained in a Basic Trie Hash Table are
* manipulated.
*
* As expansion is a method for reducing access time and is not a
* critical operation, if the table cannot be expanded at this time due
* to memory limitations, then simply return. Otherwise, initialize
* the top half of the new area, and rehash each node in the buckets of
* the lower half of the table.
*/
void expand_trie_ht(BTHTptr pHT) {
BTNptr *bucket_array; /* base address of resized hash table */
BTNptr *upper_buckets; /* marker in the resized HT delimiting where the
newly allocated buckets begin */
BTNptr *bucket; /* for stepping through buckets of the HT */
BTNptr curNode; /* TSTN being processed */
BTNptr nextNode; /* rest of the TSTNs in a bucket */
unsigned long new_size; /* double duty: new HT size, then hash mask */
new_size = TrieHT_NewSize(pHT);
bucket_array = (BTNptr *)realloc( BTHT_BucketArray(pHT),
new_size * sizeof(BTNptr) );
if ( IsNULL(bucket_array) )
return;
upper_buckets = bucket_array + BTHT_NumBuckets(pHT);
for (bucket = upper_buckets; bucket < bucket_array + new_size; bucket++)
*bucket = NULL;
BTHT_NumBuckets(pHT) = new_size;
new_size--; /* 'new_size' is now the hashing mask */
BTHT_BucketArray(pHT) = bucket_array;
for (bucket = bucket_array; bucket < upper_buckets; bucket++) {
curNode = *bucket;
*bucket = NULL;
while ( IsNonNULL(curNode) ) {
nextNode = TN_Sibling(curNode);
TrieHT_InsertNode(bucket_array, new_size, curNode);
curNode = nextNode;
}
}
}
/*----------------------------------------------------------------------*/
/*
* Push the symbols along the path from the leaf to the root in a trie
* onto the termstack.
*/
static void follow_par_chain(BTNptr pLeaf)
{
term_stackptr = -1; /* Forcibly Empty term_stack */
while ( IsNonNULL(pLeaf) && (! IsTrieRoot(pLeaf)) ) {
push_term((BTN_Symbol(pLeaf)));
pLeaf = BTN_Parent(pLeaf);
}
}
/*----------------------------------------------------------------------*/
/*
* Given a hook to an answer-list node, returns the answer contained in
* that node and updates the hook to the next node in the chain.
*/
BTNptr get_next_trie_solution(ALNptr *NextPtrPtr)
{
BTNptr TempPtr;
TempPtr = ALN_Answer(*NextPtrPtr);
*NextPtrPtr = ALN_Next(*NextPtrPtr);
return(TempPtr);
}
/*----------------------------------------------------------------------*/
#define rec_macro_make_heap_term(Macro_addr) { \
int rj,rArity; \
while(addr_stack_pointer) { \
Macro_addr = (CPtr)pop_addr; \
xtemp2 = pop_term; \
switch( TrieSymbolType(xtemp2) ) { \
case XSB_TrieVar: { \
int index = DecodeTrieVar(xtemp2); \
if (IsNewTrieVar(xtemp2)) { \
safe_assign(var_addr,index,Macro_addr,var_addr_arraysz); \
num_heap_term_vars++; \
} \
else if (IsNewTrieAttv(xtemp2)) { \
safe_assign(var_addr,index, \
(CPtr) makeattv(hreg),var_addr_arraysz); \
num_heap_term_vars++; \
new_heap_free(hreg); \
push_addr(hreg); \
hreg++; \
} \
*Macro_addr = (Cell) var_addr[index]; \
} \
break; \
case XSB_STRING: \
case XSB_INT: \
case XSB_FLOAT: \
*Macro_addr = xtemp2; \
break; \
case XSB_LIST: \
*Macro_addr = (Cell) makelist(hreg); \
hreg += 2; \
push_addr(hreg-1); \
push_addr(hreg-2); \
break; \
case XSB_STRUCT: \
*Macro_addr = (Cell) makecs(hreg); \
xtemp2 = (Cell) DecodeTrieFunctor(xtemp2); \
*hreg = xtemp2; \
rArity = (int) get_arity((Psc) xtemp2); \
for (rj= rArity; rj >= 1; rj --) { \
push_addr(hreg+rj); \
} \
hreg += rArity; \
hreg++; \
break; \
default: \
xsb_abort("Bad tag in macro_make_heap_term"); \
return; \
} \
} \
}
/*----------------------------------------------------------------------*/
#define macro_make_heap_term(ataddr,ret_val,dummy_addr) { \
int mArity,mj; \
xtemp2 = pop_term; \
switch( TrieSymbolType(xtemp2) ) { \
case XSB_TrieVar: { \
int index = DecodeTrieVar(xtemp2); \
if (IsNewTrieVar(xtemp2)) { /* diff with CHAT - Kostis */ \
safe_assign(var_addr,index,ataddr,var_addr_arraysz); \
num_heap_term_vars++; \
} \
else if (IsNewTrieAttv(xtemp2)) { \
safe_assign(var_addr, index, \
(CPtr) makeattv(hreg),var_addr_arraysz); \
num_heap_term_vars++; \
new_heap_free(hreg); \
push_addr(hreg); \
hreg++; \
rec_macro_make_heap_term(dummy_addr); \
} \
ret_val = (Cell) var_addr[index]; \
} \
break; \
case XSB_STRING: \
case XSB_INT: \
case XSB_FLOAT: \
ret_val = xtemp2; \
break; \
case XSB_LIST: \
ret_val = (Cell) makelist(hreg) ; \
hreg += 2; \
push_addr(hreg-1); \
push_addr(hreg-2); \
rec_macro_make_heap_term(dummy_addr); \
break; \
case XSB_STRUCT: \
ret_val = (Cell) makecs(hreg); \
xtemp2 = (Cell) DecodeTrieFunctor(xtemp2); \
*hreg = xtemp2; \
mArity = (int) get_arity((Psc) xtemp2); \
for (mj= mArity; mj >= 1; mj--) { \
push_addr(hreg+mj); \
} \
hreg += mArity; \
hreg++; \
rec_macro_make_heap_term(dummy_addr); \
break; \
default: \
xsb_abort("Bad tag in macro_make_heap_term"); \
return; \
} \
}
/*----------------------------------------------------------------------*/
#define recvariant_trie(flag,TrieType) { \
int j; \
\
while (!pdlempty ) { \
xtemp1 = (CPtr) pdlpop; \
XSB_CptrDeref(xtemp1); \
tag = cell_tag(xtemp1); \
switch (tag) { \
case XSB_FREE: \
case XSB_REF1: \
if (! IsStandardizedVariable(xtemp1)) { \
StandardizeAndTrailVariable(xtemp1,ctr); \
item = EncodeNewTrieVar(ctr); \
one_node_chk_ins(flag, item, TrieType); \
ctr++; \
} else { \
item = IndexOfStdVar(xtemp1); \
item = EncodeTrieVar(item); \
one_node_chk_ins(flag, item, TrieType); \
} \
break; \
case XSB_STRING: \
case XSB_INT: \
case XSB_FLOAT: \
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), TrieType); \
break; \
case XSB_LIST: \
one_node_chk_ins(flag, EncodeTrieList(xtemp1), TrieType); \
pdlpush(cell(clref_val(xtemp1)+1)); \
pdlpush(cell(clref_val(xtemp1))); \
break; \
case XSB_STRUCT: \
psc = (Psc) follow(cs_val(xtemp1)); \
item = makecs(psc); \
one_node_chk_ins(flag, item, TrieType); \
for (j = get_arity(psc); j>=1 ; j--) { \
pdlpush(cell(clref_val(xtemp1)+j)); \
} \
break; \
case XSB_ATTV: \
/* Now xtemp1 can only be the first occurrence of an attv */ \
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */ \
StandardizeAndTrailVariable(xtemp1, ctr); \
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), INTERN_TRIE_TT); \
attv_ctr++; ctr++; \
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */ \
break; \
default: \
xsb_abort("Bad type tag in recvariant_trie...\n"); \
} \
} \
resetpdl; \
}
/*----------------------------------------------------------------------*/
/*
* This is a special version of recvariant_trie(), and it is only used by
* variant_answer_search(). The only difference between this and
* recvariant_trie() is that this version will save the answer
* substitution factor into the heap (see the following lines):
*
* bld_free(hreg);
* bind_ref(xtemp1, hreg);
* xtemp1 = hreg++;
*/
#define recvariant_trie_ans_subsf(flag,TrieType) { \
int j; \
\
while (!pdlempty ) { \
xtemp1 = (CPtr) pdlpop; \
XSB_CptrDeref(xtemp1); \
tag = cell_tag(xtemp1); \
switch (tag) { \
case XSB_FREE: \
case XSB_REF1: \
if (! IsStandardizedVariable(xtemp1)){ \
bld_free(hreg); \
bind_ref(xtemp1, hreg); \
xtemp1 = hreg++; \
StandardizeAndTrailVariable(xtemp1,ctr); \
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),TrieType); \
ctr++; \
} else { \
one_node_chk_ins(flag, \
EncodeTrieVar(IndexOfStdVar(xtemp1)), \
TrieType); \
} \
break; \
case XSB_STRING: \
case XSB_INT: \
case XSB_FLOAT: \
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), TrieType); \
break; \
case XSB_LIST: \
one_node_chk_ins(flag, EncodeTrieList(xtemp1), TrieType); \
pdlpush(cell(clref_val(xtemp1)+1)); \
pdlpush(cell(clref_val(xtemp1))); \
break; \
case XSB_STRUCT: \
psc = (Psc) follow(cs_val(xtemp1)); \
item = makecs(psc); \
one_node_chk_ins(flag, item, TrieType); \
for (j = get_arity(psc); j>=1 ; j--) { \
pdlpush(cell(clref_val(xtemp1)+j)); \
} \
break; \
case XSB_ATTV: \
/* Now xtemp1 can only be the first occurrence of an attv */ \
*(hreg++) = (Cell) xtemp1; \
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */ \
StandardizeAndTrailVariable(xtemp1, ctr); \
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), TrieType); \
attv_ctr++; ctr++; \
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */ \
break; \
default: \
xsb_abort("Bad type tag in recvariant_trie_ans_subsf...\n"); \
} \
} \
resetpdl; \
}
#include "term_psc_xsb_i.h"
#include "ptoc_tag_xsb_i.h"
/*
* Called in SLG instruction `new_answer_dealloc', variant_answer_search()
* checks if the answer has been returned before and, if not, inserts it
* into the answer trie. Here, `arity' is the number of variables in the
* call (arity of the answer substitution), `attv_num' is the number of
* attributed variables in the call, `cptr' is the pointer to VarsInCall
* (all the variables in call, saved in the CP stack and already bound to
* some terms), and `subgoal_ptr' is the subgoal frame of the call. At
* the end of this function, `flagptr' tells if the answer has been
* returned before.
*
* The returned value of this function is the leaf of the answer trie.
*/
BTNptr variant_answer_search(int arity, int attv_num, CPtr cptr,
VariantSF subgoal_ptr, xsbBool *flagptr) {
Psc psc;
CPtr xtemp1;
int i, j, flag = 1;
Cell tag = XSB_FREE, item, tmp_var;
ALNptr answer_node;
ans_chk_ins++; /* Counter (answers checked & inserted) */
mini_trail_top = (CPtr *)(& mini_trail[0]) - 1;
AnsVarCtr = 0;
ctr = 0;
if ( IsNULL(subg_ans_root_ptr(subgoal_ptr)) ) {
Cell retSymbol;
if ( arity > 0 )
retSymbol = EncodeTriePSC(get_ret_psc(arity));
else
retSymbol = EncodeTrieConstant(makestring(get_ret_string()));
subg_ans_root_ptr(subgoal_ptr) =
newBasicTrie(retSymbol, BASIC_ANSWER_TRIE_TT);
}
Paren = subg_ans_root_ptr(subgoal_ptr);
GNodePtrPtr = &BTN_Child(Paren);
/*
* For each attributed variable in the call, reserve an element for it
* in VarEnumerator[]. And, if the attv is not changed in the answer,
* bind its VAR part to the corresponding element of VarEnumerator[], so
* that the later occurrences of this unchanged attv in the answer will
* be dereferenced into VarEnumerator[].
*
* (For the changed attvs, their new attributes will be constructed in
* the answer trie anyway, and their VAR part are not in the range of
* VarEnumerator[], so we don't need to do any thing for them.)
*
* To save time, this is only done when there is at least one attv in
* the call (attv_num > 0).
*/
if (attv_num > 0) {
for (i = 0; i < arity; i++) {
tmp_var = cell(cptr - i);
if (isattv(tmp_var)) {
xtemp1 = clref_val(tmp_var); /* the VAR part */
if (xtemp1 == (CPtr) cell(xtemp1)) { /* this attv is not changed */
StandardizeAndTrailVariable(xtemp1, ctr);
}
ctr++;
}
}
/* now ctr should be equal to attv_num */
}
attv_ctr = attv_num;
for (i = 0; i < arity; i++) {
xtemp1 = (CPtr) (cptr - i); /* One element of VarsInCall. It might
* have been bound in the answer for
* the call.
*/
XSB_CptrDeref(xtemp1);
tag = cell_tag(xtemp1);
switch (tag) {
case XSB_FREE:
case XSB_REF1:
if (! IsStandardizedVariable(xtemp1)) {
/*
* If this is the first occurrence of this variable, then:
*
* StandardizeAndTrailVariable(xtemp1, ctr)
* ||
* bld_ref(xtemp1, VarEnumerator[ctr]);
* *(++mini_trail_top) = xtemp1
*
* Notice that all the variables appear in the answer are bound
* to elements in VarEnumerator[], and each element in
* VarEnumerator[] is a free variable itself. Besides, all
* these variables are trailed (saved in mini_trail[]) and they
* will be used in delay_chk_insert() (in function
* do_delay_stuff()).
*/
#ifndef IGNORE_DELAYVAR
bld_free(hreg); /* To make sure there is no pointer from heap to
* local stack.
*/
bind_ref(xtemp1, hreg);
xtemp1 = hreg++;
#endif
StandardizeAndTrailVariable(xtemp1,ctr);
item = EncodeNewTrieVar(ctr);
one_node_chk_ins(flag, item, BASIC_ANSWER_TRIE_TT);
ctr++;
} else {
item = IndexOfStdVar(xtemp1);
item = EncodeTrieVar(item);
one_node_chk_ins(flag, item, BASIC_ANSWER_TRIE_TT);
}
break;
case XSB_STRING:
case XSB_INT:
case XSB_FLOAT:
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1),
BASIC_ANSWER_TRIE_TT);
break;
case XSB_LIST:
one_node_chk_ins(flag, EncodeTrieList(xtemp1), BASIC_ANSWER_TRIE_TT);
pdlpush(cell(clref_val(xtemp1)+1));
pdlpush(cell(clref_val(xtemp1)));
#ifndef IGNORE_DELAYVAR
recvariant_trie_ans_subsf(flag, BASIC_ANSWER_TRIE_TT);
#else
recvariant_trie(flag, BASIC_ANSWER_TRIE_TT);
#endif
break;
case XSB_STRUCT:
psc = (Psc)follow(cs_val(xtemp1));
item = makecs(psc);
one_node_chk_ins(flag, item, BASIC_ANSWER_TRIE_TT);
for (j = get_arity(psc); j >= 1 ; j--) {
pdlpush(cell(clref_val(xtemp1)+j));
}
#ifndef IGNORE_DELAYVAR
recvariant_trie_ans_subsf(flag, BASIC_ANSWER_TRIE_TT);
#else
recvariant_trie(flag, BASIC_ANSWER_TRIE_TT);
#endif
break;
case XSB_ATTV:
/* Now xtemp1 can only be the first occurrence of an attv */
*(hreg++) = (Cell) xtemp1;
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */
/*
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
* later occurrences of this attv will look like a regular variable
* (after dereferencing).
*/
StandardizeAndTrailVariable(xtemp1, ctr);
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), BASIC_ANSWER_TRIE_TT);
attv_ctr++; ctr++;
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */
#ifndef IGNORE_DELAYVAR
recvariant_trie_ans_subsf(flag, BASIC_ANSWER_TRIE_TT);
#else
recvariant_trie(flag, BASIC_ANSWER_TRIE_TT);
#endif
break;
default:
xsb_abort("Bad type tag in variant_answer_search()");
}
}
resetpdl;
#ifndef IGNORE_DELAYVAR
/*
* Put the substitution factor of the answer into a term ret/n (if
* the arity of the substitution factor is 0, then put integer 0
* into cell ans_var_pos_reg).
*
* Notice that simple_table_undo_bindings in the old version of XSB
* has been removed here, because all the variable bindings of this
* answer will be used later on (in do_delay_stuff()) when we build
* the delay list for this answer.
*/
if (ctr == 0)
bld_int(ans_var_pos_reg, 0);
else
bld_functor(ans_var_pos_reg, get_ret_psc(ctr));
#else /* IGNORE_DELAYVAR */
undo_answer_bindings();
#endif
/*
* Save the number of variables in the answer, i.e. the arity of
* the substitution factor of the answer, into `AnsVarCtr'.
*/
AnsVarCtr = ctr;
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> [V] AnsVarCtr = %d", AnsVarCtr));
#endif
/* if there is no term to insert, an ESCAPE node has to be created/found */
if (arity == 0) {
one_node_chk_ins(flag, ESCAPE_NODE_SYMBOL, BASIC_ANSWER_TRIE_TT);
Instr(Paren) = trie_proceed;
}
/*
* If an insertion was performed, do some maintenance on the new leaf,
* and place the answer handle onto the answer list.
*/
if ( flag == 0 ) {
MakeLeafNode(Paren);
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
ans_inserts++;
New_ALN(answer_node,Paren,NULL);
SF_AppendNewAnswer(subgoal_ptr,answer_node);
}
*flagptr = flag;
return Paren;
}
/*
* undo_answer_bindings() has the same functionality of
* simple_table_undo_bindings. It is called just after do_delay_stuff(),
* and do_delay_stuff() is called after variant_answer_search (in
* new_answer_dealloc)
*
* In XSB 1.8.1, simple_table_undo_bindings is called in
* variant_answer_search(). But to handle variables in delay list in
* do_delay_stuff() , we need the variable binding information got from
* variant_answer_search(). So we have to take simple_table_undo_bindings
* out of variant_answer_search() and call it after do_delay_stuff() is
* done.
*/
void undo_answer_bindings() {
simple_table_undo_bindings;
}
/*
* Function delay_chk_insert() is called only from intern_delay_element()
* to create the delay trie for the corresponding delay element. This
* delay trie contains the substitution factor of the answer to the subgoal
* call of this delay element. Its leaf node will be saved as a field,
* de_subs_fact_leaf, in the delay element.
*
* This function is closely related to variant_answer_search(), because it
* uses the value of AnsVarCtr that is set in variant_answer_search(). The
* body of this function is almost the same as the core part of
* variant_answer_search(), except that `ctr', the counter of the variables
* in the answer, starts from AnsVarCtr. Initially, before the first delay
* element in the delay list of a subgoal (say p/2), is interned, AnsVarCtr
* is the number of variables in the answer for p/2 and it was set in
* variant_answer_search() when this answer was returned. Then, AnsVarCtr
* will be dynamically increased as more and more delay elements for p/2
* are interned.
*
* After variant_answer_search() is finished, VarEnumerator[] contains the
* variables in the head of the corresponding clause for p/2. When we call
* delay_chk_insert() to intern the delay list for p/2, VarEnumerator[]
* will be used again to bind the variables that appear in the body.
* Because we have to check if a variable in a delay element of p/2 is
* already in the head, the old bindings of variables to VarEnumerator[]
* are still needed. So undo_answer_bindings has to be delayed.
*
* In the arguments, `arity' is the arity of the the answer substitution
* factor, `cptr' points to the first field of term ret/n (the answer
* substitution factor), `hook' is a pointer to a location where the top of
* this delay trie will become anchored. Since these delay "tries" only
* occur as single paths, there is currently no need for a root node.
*/
BTNptr delay_chk_insert(int arity, CPtr cptr, CPtr *hook)
{
Psc psc;
Cell item;
CPtr xtemp1;
int i, j, tag = XSB_FREE, flag = 1;
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> start delay_chk_insert()"));
#endif
Paren = NULL;
GNodePtrPtr = (BTNptr *) hook;
ctr = AnsVarCtr;
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> [D1] AnsVarCtr = %d", AnsVarCtr));
#endif
for (i = 0; i<arity; i++) {
/*
* Notice: the direction of saving the variables in substitution
* factors has been changed. Because Prasad saves the substitution
* factors in CP stack (--VarPosReg), but I save them in heap
* (hreg++). So (cptr - i) is changed to (cptr + i) in the
* following line.
*/
xtemp1 = (CPtr) (cptr + i);
xsb_dbgmsg((LOG_BD, "arg[%d] = %x ",i, xtemp1));
XSB_CptrDeref(xtemp1);
dbg_printterm(LOG_BD,stddbg,(unsigned int)xtemp1,25);
xsb_dbgmsg((LOG_BD, "\n"));
tag = cell_tag(xtemp1);
switch (tag) {
case XSB_FREE:
case XSB_REF1:
if (! IsStandardizedVariable(xtemp1)) {
StandardizeAndTrailVariable(xtemp1,ctr);
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),
DELAY_TRIE_TT);
ctr++;
}
else {
one_node_chk_ins(flag,
EncodeTrieVar(IndexOfStdVar(xtemp1)),
DELAY_TRIE_TT);
}
break;
case XSB_STRING:
case XSB_INT:
case XSB_FLOAT:
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), DELAY_TRIE_TT);
break;
case XSB_LIST:
one_node_chk_ins(flag, EncodeTrieList(xtemp1), DELAY_TRIE_TT);
pdlpush(cell(clref_val(xtemp1)+1));
pdlpush(cell(clref_val(xtemp1)));
recvariant_trie(flag,DELAY_TRIE_TT);
break;
case XSB_STRUCT:
one_node_chk_ins(flag, makecs(follow(cs_val(xtemp1))),DELAY_TRIE_TT);
for (j = get_arity((Psc)follow(cs_val(xtemp1))); j >= 1 ; j--) {
pdlpush(cell(clref_val(xtemp1)+j));
}
recvariant_trie(flag,DELAY_TRIE_TT);
break;
default:
xsb_abort("Bad type tag in delay_chk_insert()\n");
}
}
resetpdl;
AnsVarCtr = ctr;
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> [D2] AnsVarCtr = %d", AnsVarCtr));
#endif
/*
* If an insertion was performed, do some maintenance on the new leaf.
*/
if ( flag == 0 ) {
MakeLeafNode(Paren);
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
}
xsb_dbgmsg((LOG_BD, "----------------------------- Exit\n"));
return Paren;
}
/*----------------------------------------------------------------------*/
/* for each variable in call, builds its binding on the heap. */
/*----------------------------------------------------------------------*/
/*
* Expects that the path in the trie -- to which the variables (stored in
* the vector `cptr') are to be unified -- has been pushed onto the
* termstack.
*/
static void load_solution_from_trie(int arity, CPtr cptr)
{
int i;
CPtr xtemp1, Dummy_Addr;
Cell returned_val, xtemp2;
for (i=0; i<arity; i++) {
xtemp1 = (CPtr) (cptr-i);
XSB_CptrDeref(xtemp1);
macro_make_heap_term(xtemp1,returned_val,Dummy_Addr);
if (xtemp1 != (CPtr)returned_val) {
if (isref(xtemp1)) { /* a regular variable */
dbind_ref(xtemp1,returned_val);
}
else { /* an XSB_ATTV */
/* Bind the variable part of xtemp1 to returned_val */
dbind_ref((CPtr) dec_addr(xtemp1), returned_val);
}
}
}
resetpdl;
}
/*----------------------------------------------------------------------*/
/*
* Unifies the path in the interned trie identified by `Leaf' with the term
* `term'. It appears that `term' is expected to be an unbound variable.
* Also, `Root' does not appear to be used.
*/
static void bottomupunify(Cell term, BTNptr Root, BTNptr Leaf)
{
CPtr Dummy_Addr;
Cell returned_val, xtemp2;
CPtr gen;
int i;
num_heap_term_vars = 0;
follow_par_chain(Leaf);
XSB_Deref(term);
gen = (CPtr) term;
macro_make_heap_term(gen,returned_val,Dummy_Addr);
bld_ref(gen,returned_val);
for(i = 0; i < num_heap_term_vars; i++){
var_regs[i] = var_addr[i];
}
/*
* global_num_vars is needed by get_lastnode_cs_retskel() (see
* trie_interned/4 in intern.P).
*
* Last_Nod_Sav is also needed by get_lastnode_cs_retskel(). We can
* set it to Leaf.
*/
global_num_vars = num_vars_in_var_regs = num_heap_term_vars - 1;
Last_Nod_Sav = Leaf;
}
/*----------------------------------------------------------------------*/
/*
* Used with tries created via the builtin trie_intern.
*/
xsbBool bottom_up_unify(void)
{
Cell term;
BTNptr root;
BTNptr leaf;
int rootidx;
extern BTNptr *Set_ArrayPtr;
leaf = (BTNptr) ptoc_int(3);
if( IsDeletedNode(leaf) )
return FALSE;
term = ptoc_tag(1);
rootidx = ptoc_int(2);
root = Set_ArrayPtr[rootidx];
bottomupunify(term, root, leaf);
return TRUE;
}
/*----------------------------------------------------------------------*/
/*
* `TriePtr' is a leaf in the answer trie, and `cptr' is a vector of
* variables for receiving the substitution.
*/
void load_solution_trie(int arity, int attv_num, CPtr cptr, BTNptr TriePtr)
{
CPtr xtemp;
num_heap_term_vars = 0;
if (arity > 0) {
/* Initialize var_addr[] as the attvs in the call. */
if (attv_num > 0) {
for (xtemp = cptr; xtemp > cptr - arity; xtemp--) {
if (isattv(cell(xtemp)))
var_addr[num_heap_term_vars++] = (CPtr) cell(xtemp);
}
}
follow_par_chain(TriePtr);
load_solution_from_trie(arity,cptr);
}
}
/*----------------------------------------------------------------------*/
void load_delay_trie(int arity, CPtr cptr, BTNptr TriePtr)
{
if (arity) {
follow_par_chain(TriePtr);
load_solution_from_trie(arity,cptr);
}
}
/*----------------------------------------------------------------------*/
#define recvariant_call(flag,TrieType,xtemp1) { \
int j; \
\
while (!pdlempty) { \
xtemp1 = (CPtr) pdlpop; \
XSB_CptrDeref(xtemp1); \
switch(tag = cell_tag(xtemp1)) { \
case XSB_FREE: \
case XSB_REF1: \
if (! IsStandardizedVariable(xtemp1)) { \
*(--VarPosReg) = (Cell) xtemp1; \
StandardizeVariable(xtemp1,ctr); \
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),TrieType); \
ctr++; \
} else{ \
one_node_chk_ins(flag, EncodeTrieVar(IndexOfStdVar(xtemp1)), \
TrieType); \
} \
break; \
case XSB_STRING: \
case XSB_INT: \
case XSB_FLOAT: \
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), TrieType); \
break; \
case XSB_LIST: \
one_node_chk_ins(flag, EncodeTrieList(xtemp1), TrieType); \
pdlpush( cell(clref_val(xtemp1)+1) ); \
pdlpush( cell(clref_val(xtemp1)) ); \
break; \
case XSB_STRUCT: \
psc = (Psc) follow(cs_val(xtemp1)); \
item = makecs(psc); \
one_node_chk_ins(flag, item, TrieType); \
for (j=get_arity(psc); j>=1; j--) { \
pdlpush(cell(clref_val(xtemp1)+j)); \
} \
break; \
case XSB_ATTV: \
/* Now xtemp1 can only be the first occurrence of an attv */ \
*(--VarPosReg) = (Cell) xtemp1; \
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */ \
StandardizeVariable(xtemp1, ctr); \
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), TrieType); \
attv_ctr++; ctr++; \
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */ \
break; \
default: \
xsb_abort("Bad type tag in recvariant_call...\n"); \
} \
} \
resetpdl; \
}
/*----------------------------------------------------------------------*/
/*
* Searches/inserts a subgoal call structure into a subgoal call trie.
* During search/insertion, the variables of the subgoal call are pushed
* on top of the CP stack (through VarPosReg), along with the # of
* variables that were pushed. This forms the substitution factor.
* Prolog variables are standardized during this process to recognize
* multiple (nonlinear) occurences. They must be reset to an unbound
* state before termination.
* Many global variables:
* Paren - to be set to point to inserted term's leaf
* VarPosReg - pointer to top of CPS; place to put the substitution factor
* in high-to-low memory format.
* GNodePtrPtr - local to file? Points to the parent-internal-structure's
* "child" or "NODE_link" field. It's a place to anchor any newly
* created NODEs.
* ctr - local to file; contains the number of distinct variables found
* in the call.
* Pay careful attention to the expected argument vector accepted by this
* function. It actually points one Cell *before* the term vector! Notice
* the treatment of "cptr" as these terms are inspected.
*/
void variant_call_search(TabledCallInfo *call_info,
CallLookupResults *results)
{
Psc psc;
CPtr call_arg;
int arity, i, j, flag = 1;
Cell tag = XSB_FREE, item;
CPtr cptr, VarPosReg, tVarPosReg;
subg_chk_ins++;
Paren = TIF_CallTrie(CallInfo_TableInfo(*call_info));
GNodePtrPtr = &BTN_Child(Paren);
arity = CallInfo_CallArity(*call_info);
cptr = CallInfo_Arguments(*call_info);
tVarPosReg = VarPosReg = CallInfo_VarVectorLoc(*call_info);
ctr = attv_ctr = 0;
for (i = 0; i < arity; i++) {
call_arg = (CPtr) (cptr + i); /* Note! */
XSB_CptrDeref(call_arg);
tag = cell_tag(call_arg);
switch (tag) {
case XSB_FREE:
case XSB_REF1:
if (! IsStandardizedVariable(call_arg)) {
/*
* Point all local variables to heap. This is required to support
* attributed variables in tabling: in order to share unchanged
* attributed variables between subgoal trie and answer trie, any
* cell in the substitution factor of the call CANNOT be a FREE
* variable itself.
*
* Since the substitution factor will be moved onto heap in CHAT,
* the new substitution factor may contain FREE variables if we
* don't point the local variables to heap here.
*/
if (top_of_localstk <= call_arg &&
call_arg <= (CPtr) glstack.high - 1) {
bld_free(hreg);
bind_ref(call_arg, hreg);
call_arg = hreg++;
}
/*
* Save pointers of the substitution factor of the call into CP
* stack. Each pointer points to a variable in the heap (in CHAT)
* or heap/local stack (in SLG-WAM). The variables may get bound
* in the later computation.
*/
*(--VarPosReg) = (Cell) call_arg;
StandardizeVariable(call_arg,ctr);
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),
CALL_TRIE_TT);
ctr++;
} else {
one_node_chk_ins(flag,EncodeTrieVar(IndexOfStdVar(call_arg)),CALL_TRIE_TT);
}
break;
case XSB_STRING:
case XSB_INT:
case XSB_FLOAT:
one_node_chk_ins(flag, EncodeTrieConstant(call_arg), CALL_TRIE_TT);
break;
case XSB_LIST:
one_node_chk_ins(flag, EncodeTrieList(call_arg), CALL_TRIE_TT);
pdlpush(cell(clref_val(call_arg)+1));
pdlpush(cell(clref_val(call_arg)));
recvariant_call(flag,CALL_TRIE_TT,call_arg);
break;
case XSB_STRUCT:
psc = (Psc)follow(cs_val(call_arg));
item = makecs(psc);
one_node_chk_ins(flag, item, CALL_TRIE_TT);
for (j=get_arity(psc); j>=1 ; j--) {
pdlpush(cell(clref_val(call_arg)+j));
}
recvariant_call(flag,CALL_TRIE_TT,call_arg);
break;
case XSB_ATTV:
/* Now call_arg can only be the first occurrence of an attv */
*(--VarPosReg) = (Cell) call_arg;
call_arg = clref_val(call_arg); /* the VAR part of the attv */
/*
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
* later occurrences of this attv will look like a regular variable
* (after dereferencing).
*/
StandardizeVariable(call_arg, ctr);
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), CALL_TRIE_TT);
attv_ctr++; ctr++;
pdlpush(cell(call_arg+1)); /* the ATTR part of the attv */
recvariant_call(flag, CALL_TRIE_TT, call_arg);
break;
default:
xsb_abort("Bad type tag in variant_call_search...\n");
}
}
resetpdl;
if (arity == 0) {
one_node_chk_ins(flag, ESCAPE_NODE_SYMBOL, CALL_TRIE_TT);
Instr(Paren) = trie_proceed;
}
/*
* If an insertion was performed, do some maintenance on the new leaf.
*/
if ( flag == 0 ) {
subg_inserts++;
MakeLeafNode(Paren);
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
}
cell(--VarPosReg) = makeint(attv_ctr << 16 | ctr);
while (--tVarPosReg > VarPosReg) {
if (isref(*tVarPosReg)) /* a regular variable */
ResetStandardizedVariable(*tVarPosReg);
else /* an XSB_ATTV */
ResetStandardizedVariable(clref_val(*tVarPosReg));
}
CallLUR_Leaf(*results) = Paren;
CallLUR_Subsumer(*results) = CallTrieLeaf_GetSF(Paren);
CallLUR_VariantFound(*results) = flag;
CallLUR_VarVector(*results) = VarPosReg;
return;
}
/*----------------------------------------------------------------------*/
static void remove_calls_and_returns(VariantSF CallStrPtr)
{
ALNptr pALN;
/* Delete the call entry
--------------------- */
delete_branch(subg_leaf_ptr(CallStrPtr),
&TIF_CallTrie(subg_tif_ptr(CallStrPtr)));
/* Delete its answers
------------------ */
for ( pALN = subg_answers(CallStrPtr); IsNonNULL(pALN);
pALN = ALN_Next(pALN) )
delete_branch(ALN_Answer(pALN), &subg_ans_root_ptr(CallStrPtr));
/* Delete the table entry
---------------------- */
free_answer_list(CallStrPtr);
FreeProducerSF(CallStrPtr);
}
void remove_open_tries(CPtr bottom_parameter)
{
xsbBool warned = FALSE;
VariantSF CallStrPtr;
while (openreg < bottom_parameter) {
CallStrPtr = (VariantSF)compl_subgoal_ptr(openreg);
if (!is_completed(CallStrPtr)) {
if (warned == FALSE) {
xsb_mesg("Removing incomplete tables...");
check_table_cut = FALSE; /* permit cuts over tables */
warned = TRUE;
}
remove_calls_and_returns(CallStrPtr);
}
openreg += COMPLFRAMESIZE;
}
}
/*----------------------------------------------------------------------*/
/*
* For creating interned tries via buitin "trie_intern".
*/
BTNptr whole_term_chk_ins(Cell term, BTNptr *hook, int *flagptr)
{
Psc psc;
CPtr xtemp1;
int j, flag = 1;
Cell tag = XSB_FREE, item;
if ( IsNULL(*hook) )
*hook = newBasicTrie(EncodeTriePSC(get_intern_psc()),INTERN_TRIE_TT);
Paren = *hook;
GNodePtrPtr = &BTN_Child(Paren);
xtemp1 = (CPtr) term;
XSB_CptrDeref(xtemp1);
tag = cell_tag(xtemp1);
mini_trail_top = (CPtr *)(& mini_trail[0]) - 1;
ctr = attv_ctr = 0;
switch (tag) {
case XSB_FREE:
case XSB_REF1:
if (! IsStandardizedVariable(xtemp1)) {
StandardizeAndTrailVariable(xtemp1,ctr);
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),
INTERN_TRIE_TT);
ctr++;
} else {
one_node_chk_ins(flag,
EncodeTrieVar(IndexOfStdVar(xtemp1)),
INTERN_TRIE_TT);
}
break;
case XSB_STRING:
case XSB_INT:
case XSB_FLOAT:
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), INTERN_TRIE_TT);
break;
case XSB_LIST:
one_node_chk_ins(flag, EncodeTrieList(xtemp1), INTERN_TRIE_TT);
pdlpush(cell(clref_val(xtemp1)+1));
pdlpush(cell(clref_val(xtemp1)));
recvariant_trie(flag,INTERN_TRIE_TT);
break;
case XSB_STRUCT:
one_node_chk_ins(flag, makecs(follow(cs_val(xtemp1))),INTERN_TRIE_TT);
for (j = get_arity((Psc)follow(cs_val(xtemp1))); j >= 1 ; j--) {
pdlpush(cell(clref_val(xtemp1)+j));
}
recvariant_trie(flag,INTERN_TRIE_TT);
break;
case XSB_ATTV:
/* Now xtemp1 can only be the first occurrence of an attv */
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */
/*
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
* later occurrences of this attv will look like a regular variable
* (after dereferencing).
*/
StandardizeAndTrailVariable(xtemp1, ctr);
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), INTERN_TRIE_TT);
attv_ctr++; ctr++;
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */
recvariant_trie(flag, INTERN_TRIE_TT);
break;
default:
xsb_abort("Bad type tag in whole_term_check_ins()");
}
/*
* If an insertion was performed, do some maintenance on the new leaf.
*/
if ( flag == 0 ) {
MakeLeafNode(Paren);
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
}
/*
* var_regs[] is used to construct the last argument of trie_intern/5
* (Skel). This is done in construct_ret(), which is called in
* get_lastnode_cs_retskel().
*/
for (j = 0; j < ctr; j++) var_regs[j] = mini_trail[j];
/*
* Both global_num_vars and Last_Nod_Sav are needed by
* get_lastnode_cs_retskel() (see trie_intern/5 in intern.P).
*/
global_num_vars = num_vars_in_var_regs = ctr - 1;
Last_Nod_Sav = Paren;
simple_table_undo_bindings;
/* if node was deleted, then return 0 to indicate that the insertion took
place conceptually (even if not physically */
if (IsDeletedNode(Paren)) {
*flagptr = 0;
undelete_branch(Paren);
} else
*flagptr = flag;
return(Paren);
}
/*----------------------------------------------------------------------*/
/* one_term_chk_ins(termptr,hook,flag) */
/*----------------------------------------------------------------------*/
/*
* For creating asserted tries with builtin "trie_assert".
*/
BTNptr one_term_chk_ins(CPtr termptr, BTNptr root, int *flagptr)
{
int arity;
CPtr cptr;
CPtr xtemp1;
int i, j, flag = 1;
Cell tag = XSB_FREE, item;
Psc psc;
psc = term_psc((prolog_term)termptr);
arity = get_arity(psc);
cptr = (CPtr)cs_val(termptr);
mini_trail_top = (CPtr *)(& mini_trail[0]) - 1;
ctr = attv_ctr = 0;
/*
* The value of `Paren' effects the "body" of the trie: nodes which
* are created the first level down get this value in their parent
* field. This could be a problem when deleting trie paths, as this
* root needs to persist beyond the life of its body.
*/
Paren = root;
GNodePtrPtr = &BTN_Child(root);
for (i = 1; i<=arity; i++) {
xtemp1 = (CPtr) (cptr + i);
XSB_CptrDeref(xtemp1);
tag = cell_tag(xtemp1);
switch (tag) {
case XSB_FREE:
case XSB_REF1:
if (! IsStandardizedVariable(xtemp1)) {
StandardizeAndTrailVariable(xtemp1,ctr);
one_node_chk_ins(flag, EncodeNewTrieVar(ctr),
ASSERT_TRIE_TT);
ctr++;
} else {
one_node_chk_ins(flag,
EncodeTrieVar(IndexOfStdVar(xtemp1)),
ASSERT_TRIE_TT);
}
break;
case XSB_STRING:
case XSB_INT:
case XSB_FLOAT:
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), ASSERT_TRIE_TT);
break;
case XSB_LIST:
one_node_chk_ins(flag, EncodeTrieList(xtemp1), ASSERT_TRIE_TT);
pdlpush(cell(clref_val(xtemp1)+1));
pdlpush(cell(clref_val(xtemp1)));
recvariant_trie(flag,ASSERT_TRIE_TT);
break;
case XSB_STRUCT:
psc = (Psc) follow(cs_val(xtemp1));
one_node_chk_ins(flag, makecs(psc),ASSERT_TRIE_TT);
for (j = get_arity(psc); j >= 1 ; j--) {
pdlpush(cell(clref_val(xtemp1)+j));
}
recvariant_trie(flag,ASSERT_TRIE_TT);
break;
case XSB_ATTV:
/* Now xtemp1 can only be the first occurrence of an attv */
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */
/*
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
* later occurrences of this attv will look like a regular variable
* (after dereferencing).
*/
StandardizeAndTrailVariable(xtemp1, ctr);
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), ASSERT_TRIE_TT);
attv_ctr++; ctr++;
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */
recvariant_trie(flag, ASSERT_TRIE_TT);
break;
default:
xsb_abort("Bad type tag in one_term_check_ins()");
}
}
resetpdl;
simple_table_undo_bindings;
/* if there is no term to insert, an ESCAPE node has to be created/found */
if (arity == 0) {
one_node_chk_ins(flag, ESCAPE_NODE_SYMBOL, ASSERT_TRIE_TT);
Instr(Paren) = trie_proceed;
}
/*
* If an insertion was performed, do some maintenance on the new leaf.
*/
if ( flag == 0 ) {
MakeLeafNode(Paren);
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
}
*flagptr = flag;
return(Paren);
}
/*----------------------------------------------------------------------*/
/*
* This is builtin #150: TRIE_GET_RETURN
*/
byte *trie_get_returns(VariantSF sf, Cell retTerm) {
BTNptr ans_root_ptr;
Cell retSymbol;
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> (at the beginning of trie_get_returns"));
xsb_dbgmsg((LOG_DEBUG,">>>> num_vars_in_var_regs = %d)", num_vars_in_var_regs));
#endif
if ( IsProperlySubsumed(sf) )
ans_root_ptr = subg_ans_root_ptr(conssf_producer(sf));
else
ans_root_ptr = subg_ans_root_ptr(sf);
if ( IsNULL(ans_root_ptr) )
return (byte *)&fail_inst;
if ( isconstr(retTerm) )
retSymbol = EncodeTrieFunctor(retTerm); /* ret/n rep as XSB_STRUCT */
else
retSymbol = retTerm; /* ret/0 would be represented as a XSB_STRING */
if ( retSymbol != BTN_Symbol(ans_root_ptr) )
return (byte *)&fail_inst;
num_vars_in_var_regs = -1;
if ( isconstr(retTerm) ) {
int i, arity;
CPtr cptr;
arity = get_arity(get_str_psc(retTerm));
/* Initialize var_regs[] as the attvs in the call. */
for (i = 0, cptr = clref_val(retTerm) + 1; i < arity; i++, cptr++) {
if (isattv(cell(cptr)))
var_regs[++num_vars_in_var_regs] = (CPtr) cell(cptr);
}
/* now num_vars_in_var_regs should be attv_num - 1 */
reg_arrayptr = reg_array -1;
for (i = arity, cptr = clref_val(retTerm); i >= 1; i--) {
pushreg(cell(cptr+i));
}
}
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> The end of trie_get_returns ==> go to answer trie"));
#endif
delay_it = 0; /* Don't delay the answer. */
return (byte *)ans_root_ptr;
}
/*----------------------------------------------------------------------*/
byte * trie_get_calls(void)
{
Cell call_term;
Psc psc_ptr;
TIFptr tip_ptr;
BTNptr call_trie_root;
CPtr cptr;
int i;
call_term = ptoc_tag(1);
if ((psc_ptr = term_psc(call_term)) != NULL) {
tip_ptr = get_tip(psc_ptr);
if (tip_ptr == NULL) {
xsb_abort("get_calls/3 called with non-tabled predicate");
return (byte *)&fail_inst;
}
call_trie_root = TIF_CallTrie(tip_ptr);
if (call_trie_root == NULL)
return (byte *)&fail_inst;
else {
cptr = (CPtr)cs_val(call_term);
reg_arrayptr = reg_array-1;
num_vars_in_var_regs = -1;
for (i = get_arity(psc_ptr); i>=1; i--) {
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> push one cell"));
#endif
pushreg(cell(cptr+i));
}
return (byte *)call_trie_root;
}
}
else
return (byte *)&fail_inst;
}
/*----------------------------------------------------------------------*/
/*
* This function is changed from get_lastnode_and_retskel(). It is the
* body of *inline* builtin GET_LASTNODE_CS_RETSKEL(LastNode, CallStr,
* RetSkel). [1/9/1999]
*
* This function is called immediately after using the trie intructions
* to traverse one branch of the call or answer trie. A side-effect of
* executing these instructions is that the leaf node of the branch is
* left in a global variable "Last_Nod_Sav". One reason for writing it
* so is that it is important that the construction of the return
* skeleton is an operation that cannot be interrupted by garbage
* collection.
*
* In case we just traversed the Call Trie of a subsumptive predicate,
* and the call we just unified with is subsumed, then the answer
* template (i.e., the return) must be reconstructed based on the
* original call, the argument "callTerm" below, and the subsuming call
* in the table. Otherwise, we return the variables placed in
* "var_regs[]" during the embedded-trie-code walk.
*/
Cell get_lastnode_cs_retskel(Cell callTerm) {
int arity;
Cell *vector;
arity = global_num_vars + 1;
vector = (Cell *)var_regs;
if ( IsInCallTrie(Last_Nod_Sav) ) {
VariantSF sf = CallTrieLeaf_GetSF(Last_Nod_Sav);
if ( IsProperlySubsumed(sf) ) {
construct_answer_template(callTerm, conssf_producer(sf),
(Cell *)var_regs);
arity = (int)var_regs[0];
vector = (Cell *)&var_regs[1];
}
}
return ( build_ret_term(arity, vector) );
}
/*----------------------------------------------------------------------*/
/* creates an empty (dummy) answer. */
/*----------------------------------------------------------------------*/
ALNptr empty_return(void)
{
ALNptr i;
/* Used only in one context hence this abuse */
New_ALN(i,&dummy_ans_node,NULL);
return i;
}
/*----------------------------------------------------------------------*/
syntax highlighted by Code2HTML, v. 0.9.1