2
** Author(s): Prasad Rao, David S. Warren, Kostis Sagonas,
3
** Juliana Freire, Baoqiu Cui
4
** Contact: xsb-contact@cs.sunysb.edu
6
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
7
** Copyright (C) ECRC, Germany, 1990
9
** XSB is free software; you can redistribute it and/or modify it under the
10
** terms of the GNU Library General Public License as published by the Free
11
** Software Foundation; either version 2 of the License, or (at your option)
14
** XSB is distributed in the hope that it will be useful, but WITHOUT ANY
15
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
16
** FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for
19
** You should have received a copy of the GNU Library General Public License
20
** along with XSB; if not, write to the Free Software Foundation,
21
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
23
** $Id: tries.c,v 1.87 2006/05/22 14:53:44 dwarren Exp $
28
#include "xsb_config.h"
29
#include "xsb_debug.h"
34
/* Special debug includes */
35
#include "debugs/debug_tries.h"
42
#include "flags_xsb.h"
44
#include "memory_xsb.h"
47
#include "trie_internals.h"
48
#include "macro_xsb.h"
51
#include "error_xsb.h"
54
#include "thread_xsb.h"
55
#include "debug_xsb.h"
58
/*----------------------------------------------------------------------*/
59
/* The following variables are used in other parts of the system */
60
/*----------------------------------------------------------------------*/
62
long subg_chk_ins, subg_inserts, ans_chk_ins, ans_inserts; /* statistics */
65
int num_heap_term_vars;
68
Cell VarEnumerator[NUM_TRIEVARS];
69
Cell TrieVarBindings[NUM_TRIEVARS];
72
/* xsbBool check_table_cut = TRUE; flag for close_open_tables to turn off
73
cut-over-table check */
76
* global_num_vars is a new variable to save the value of variable
77
* num_vars_in_var_regs temporarily.
84
* Array VarEnumerator_trail[] is used to trail the variable bindings when we
85
* copy terms into tries. The variables trailed using VarEnumerator_trail are
86
* those that are bound to elements in VarEnumerator[].
89
static CPtr VarEnumerator_trail[NUM_TRIEVARS];
90
static CPtr *VarEnumerator_trail_top;
94
char *trie_node_type_table[] = {"interior_nt","hashed_interior_nt","leaf_nt",
95
"hashed_leaf_nt","hash_header_nt","undefined",
96
"undefined","undefined","trie_root_nt"};
98
char *trie_trie_type_table[] = {"call_trie_tt","basic_answer_trie_tt",
99
"ts_answer_trie_tt","delay_trie_tt",
100
"assert_trie_tt","intern_trie_tt"
103
/*----------------------------------------------------------------------*/
104
/* Safe assignment -- can be generalized by type.
105
CPtr can be abstracted out */
106
#define safe_assign(ArrayNam,Index,Value,ArraySz) {\
107
if (Index >= ArraySz) {\
108
trie_expand_array(CPtr,ArrayNam,ArraySz,Index,"var_addr");\
110
ArrayNam[Index] = Value;\
113
/*----------------------------------------------------------------------*/
114
/*****************Addr Stack*************
116
TLS 08/05: The addr_stack and term_stack (below) are used by
117
answer_return. to copy information out of a trie and into a ret/n
118
structure. Its also used by table predicates to get delay lists.
123
static int addr_stack_pointer = 0;
124
static CPtr *Addr_Stack;
125
static int addr_stack_size = DEFAULT_ARRAYSIZ;
128
#define pop_addr Addr_Stack[--addr_stack_pointer]
129
#define push_addr(X) {\
130
if (addr_stack_pointer == addr_stack_size) {\
131
trie_expand_array(CPtr, Addr_Stack ,addr_stack_size,0,"Addr_Stack");\
133
Addr_Stack[addr_stack_pointer++] = ((CPtr) X);\
136
/*----------------------------------------------------------------------*/
137
/*****************Term Stack*************/
139
static int term_stackptr = -1;
140
static Cell *term_stack;
141
static long term_stacksize = DEFAULT_ARRAYSIZ;
144
#define pop_term term_stack[term_stackptr--]
145
#define push_term(T) {\
146
if (term_stackptr+1 == term_stacksize) {\
147
trie_expand_array(Cell,term_stack,term_stacksize,0,"term_stack");\
149
term_stack[++term_stackptr] = ((Cell) T);\
152
/*----------------------------------------------------------------------*/
153
/*********Simpler trails ****************/
155
#define simple_table_undo_bindings \
156
while (VarEnumerator_trail_top >= VarEnumerator_trail) { \
157
untrail(*VarEnumerator_trail_top); \
158
VarEnumerator_trail_top--; \
161
#define StandardizeAndTrailVariable(addr,n) \
162
StandardizeVariable(addr,n); \
163
*(++VarEnumerator_trail_top) = addr;
165
/*----------------------------------------------------------------------*/
166
/* Variables used only in this file */
167
/*----------------------------------------------------------------------*/
169
static BasicTrieNode dummy_ans_node = {{0,1,0,0},NULL,NULL,NULL,0};
172
static int AnsVarCtr;
175
/*----------------------------------------------------------------------*/
178
* T R I E S T R U C T U R E M A N A G E M E N T
179
* =================================================
181
char *TrieSMNameTable[] = {"Basic Trie Node (Private)",
182
"Basic Trie Hash Table (Private)"};
184
/* For Call and Answer Tries
185
------------------------- */
187
Structure_Manager smTableBTN = SM_InitDecl(BasicTrieNode, BTNs_PER_BLOCK,
189
Structure_Manager smTableBTHT = SM_InitDecl(BasicTrieHT, BTHTs_PER_BLOCK,
190
"Basic Trie Hash Table");
192
/* For Assert & Intern Tries
193
------------------------- */
194
Structure_Manager smAssertBTN = SM_InitDecl(BasicTrieNode, BTNs_PER_BLOCK,
196
Structure_Manager smAssertBTHT = SM_InitDecl(BasicTrieHT, BTHTs_PER_BLOCK,
197
"Basic Trie Hash Table");
199
/* Maintains Current Structure Space
200
--------------------------------- */
202
/* MT engine uses both shared and private structure managers,
203
sequential engine doesn't. In addition, in MT engine, all
204
subsumptive tables are private, thus use subsumptive_smBTN/BTHT for
205
structure managers common to both variant and private tables. */
208
Structure_Manager smTSTN = SM_InitDecl(TS_TrieNode, TSTNs_PER_BLOCK,
209
"Time-Stamped Trie Node");
210
Structure_Manager smTSTHT = SM_InitDecl(TST_HashTable, TSTHTs_PER_BLOCK,
211
"Time-Stamped Trie Hash Table");
212
Structure_Manager smTSIN = SM_InitDecl(TS_IndexNode, TSINs_PER_BLOCK,
213
"Time-Stamp Indexing Node");
215
Structure_Manager *smBTN = &smTableBTN;
216
Structure_Manager *smBTHT = &smTableBTHT;
221
/*----------------------------------------------------------------------*/
223
void init_trie_aux_areas(CTXTdecl)
227
/* TLS: commented these out to catch private/shared bugs more
231
smBTHT = &smTableBTHT;
236
addr_stack_pointer = 0;
242
var_addr_arraysz = 0;
247
reg_arrayptr = reg_array -1;
249
for (i = 0; i < NUM_TRIEVARS; i++)
250
VarEnumerator[i] = (Cell) & (VarEnumerator[i]);
253
void free_trie_aux_areas(CTXTdecl)
255
mem_dealloc(term_stack,term_stacksize,TABLE_SPACE);
256
mem_dealloc(var_addr,var_addr_arraysz,TABLE_SPACE);
257
mem_dealloc(Addr_Stack,addr_stack_size,TABLE_SPACE);
258
mem_dealloc(reg_array,reg_array_size,TABLE_SPACE);
261
/*-------------------------------------------------------------------------*/
263
BTNptr new_btn(CTXTdeclc int trie_t, int node_t, Cell symbol, BTNptr parent,
269
if (threads_current_sm == PRIVATE_SM) {
270
SM_AllocateStruct(*smBTN,btn);
272
SM_AllocateSharedStruct(*smBTN,btn);
275
SM_AllocateStruct(*smBTN,btn);
277
TN_Init(((BTNptr)btn),trie_t,node_t,symbol,parent,sibling);
281
/*-------------------------------------------------------------------------*/
283
TSTNptr new_tstn(CTXTdeclc int trie_t, int node_t, Cell symbol, TSTNptr parent,
288
SM_AllocateStruct(smTSTN,tstn);
289
TN_Init(((TSTNptr)tstn),trie_t,node_t,symbol,parent,sibling);
290
TSTN_TimeStamp(((TSTNptr)tstn)) = TSTN_DEFAULT_TIMESTAMP;
291
return (TSTNptr)tstn;
294
/*-------------------------------------------------------------------------*/
297
* Creates a root node for a given type of trie.
300
BTNptr newBasicTrie(CTXTdeclc Cell symbol, int trie_type) {
304
New_BTN( pRoot, trie_type, TRIE_ROOT_NT, symbol, NULL, NULL );
308
/*-------------------------------------------------------------------------*/
311
* Creates a root node for a given type of trie. Differs from above in that
312
* the parent is intended to be set to the subgoal frame.
315
BTNptr newBasicAnswerTrie(CTXTdeclc Cell symbol, CPtr Paren, int trie_type) {
319
New_BTN( pRoot, trie_type, TRIE_ROOT_NT, symbol, Paren, NULL );
323
/*----------------------------------------------------------------------*/
325
/* Used by one_node_chk_ins only. */
326
#define IsInsibling(wherefrom,count,Found,item,TrieType) \
328
LocalNodePtr = wherefrom; \
329
while (LocalNodePtr && (BTN_Symbol(LocalNodePtr) != item)) { \
330
LocalNodePtr = BTN_Sibling(LocalNodePtr); \
333
if ( IsNULL(LocalNodePtr) ) { \
335
New_BTN(LocalNodePtr,TrieType,INTERIOR_NT,item,Paren,wherefrom); \
337
wherefrom = LocalNodePtr; /* hook the new node into the trie */ \
339
Paren = LocalNodePtr; \
344
* Insert/find a single symbol in the trie structure 1-level beneath a
345
* parent NODE, pointed to by `Paren', whose child link field is
346
* pointed to by 'GNodePtrPtr'. (If 'Paren' is NULL, then we are most
347
* likely searching beneath some other structure, like the TIP, and
348
* 'GNodePtrPtr' points to its "trie root" field.) If the symbol
349
* cannot be found, create a NODE for this symbol and make it the child
350
* of `Paren' by setting the field that 'GNodePtrPtr' points to to this
351
* new NODE. Upon exiting this macro, 'Paren' is set to point to the
352
* node containing this symbol and 'GNodePtrPtr' gets the address of
353
* this nodes' Child field.
357
* If the parent has no children, then create a node for the symbol
358
* and link it to the parent and vice versa. Set the `Found' flag to
359
* indicate that a new node was necessary.
361
* Otherwise, if the parent utilizes a hash structure for maintaining
362
* its children, check to see if there is enough room for one more
363
* entry. If not, then expand the hash structure. Search for the
364
* node containing the symbol in question, inserting it if it is not
365
* found. Signify through `Found' the result of this action.
367
* Otherwise, look for the symbol in a normal chain of children
368
* beneath the parent. If it is not found, then insert it and check
369
* to see if the chain has now become too long; if so, then create a
370
* hash structure for the parent's children. Signify through `Found'
371
* the result of this action.
373
* Prepare for the next insertion/lookup by changing the `hook' to
374
* that of the child pointer field of the node which contains the
375
* just-processed symbol.
378
#define one_node_chk_ins(Found,item,TrieType) { \
381
BTNptr LocalNodePtr; \
384
if ( IsNULL(*GNodePtrPtr) ) { \
385
New_BTN(LocalNodePtr,TrieType,INTERIOR_NT,item,Paren,NULL); \
386
*GNodePtrPtr = Paren = LocalNodePtr; \
389
else if ( IsHashHeader(*GNodePtrPtr) ) { \
390
BTHTptr ht = (BTHTptr)*GNodePtrPtr; \
391
GNodePtrPtr = CalculateBucketForSymbol(ht,item); \
392
IsInsibling(*GNodePtrPtr,count,Found,item,TrieType); \
394
MakeHashedNode(LocalNodePtr); \
395
BTHT_NumContents(ht)++; \
396
TrieHT_ExpansionCheck(ht,count); \
400
BTNptr pParent = Paren; \
401
IsInsibling(*GNodePtrPtr,count,Found,item,TrieType); \
402
if (IsLongSiblingChain(count)) \
403
/* used to pass in GNodePtrPtr (ptr to hook) */ \
404
hashify_children(CTXTc pParent,TrieType); \
406
GNodePtrPtr = &(BTN_Child(LocalNodePtr)); \
410
/*----------------------------------------------------------------------*/
412
/* Trie-HashTable maintenance routines.
413
------------------------------------
414
parentHook is the address of a field in some structure (should now be
415
another trie node as all tries now have roots) which points to a chain
416
of trie nodes whose length has become "too long."
419
void hashify_children(CTXTdeclc BTNptr parent, int trieType) {
421
BTNptr children; /* child list of the parent */
422
BTNptr btn; /* current child for processing */
423
BTHTptr ht; /* HT header struct */
424
BTNptr *tablebase; /* first bucket of allocated HT */
425
unsigned long hashseed; /* needed for hashing of BTNs */
428
New_BTHT(ht,trieType);
429
children = BTN_Child(parent);
430
BTN_SetHashHdr(parent,ht);
431
tablebase = BTHT_BucketArray(ht);
432
hashseed = BTHT_GetHashSeed(ht);
433
for (btn = children; IsNonNULL(btn); btn = children) {
434
children = BTN_Sibling(btn);
435
TrieHT_InsertNode(tablebase, hashseed, btn);
440
/*-------------------------------------------------------------------------*/
443
* Expand the hash table pointed to by 'pHT'. Note that we can do this
444
* in place by using realloc() and noticing that, since the hash tables
445
* and hashing function are based on powers of two, a node existing in
446
* a bucket will either remain in that bucket -- in the lower part of
447
* the new table -- or jump to a corresponding bucket in the upper half
448
* of the expanded table. This function can serve for all types of
449
* tries since only fields contained in a Basic Trie Hash Table are
452
* As expansion is a method for reducing access time and is not a
453
* critical operation, if the table cannot be expanded at this time due
454
* to memory limitations, then simply return. Otherwise, initialize
455
* the top half of the new area, and rehash each node in the buckets of
456
* the lower half of the table.
460
void expand_trie_ht(BTHTptr pHT) {
462
BTNptr *bucket_array; /* base address of resized hash table */
463
BTNptr *upper_buckets; /* marker in the resized HT delimiting where the
464
newly allocated buckets begin */
466
BTNptr *bucket; /* for stepping through buckets of the HT */
468
BTNptr curNode; /* TSTN being processed */
469
BTNptr nextNode; /* rest of the TSTNs in a bucket */
471
unsigned long new_size; /* double duty: new HT size, then hash mask */
474
new_size = TrieHT_NewSize(pHT);
475
bucket_array = (BTNptr *)mem_realloc( BTHT_BucketArray(pHT), BTHT_NumBuckets(pHT)*sizeof(void*),
476
new_size * sizeof(BTNptr),TABLE_SPACE );
477
if ( IsNULL(bucket_array) )
480
upper_buckets = bucket_array + BTHT_NumBuckets(pHT);
481
for (bucket = upper_buckets; bucket < bucket_array + new_size; bucket++)
483
BTHT_NumBuckets(pHT) = new_size;
484
new_size--; /* 'new_size' is now the hashing mask */
485
BTHT_BucketArray(pHT) = bucket_array;
486
for (bucket = bucket_array; bucket < upper_buckets; bucket++) {
489
while ( IsNonNULL(curNode) ) {
490
nextNode = TN_Sibling(curNode);
491
TrieHT_InsertNode(bucket_array, new_size, curNode);
497
/*----------------------------------------------------------------------*/
500
* Push the symbols along the path from the leaf to the root in a trie
501
* onto the termstack.
503
static void follow_par_chain(CTXTdeclc BTNptr pLeaf)
505
term_stackptr = -1; /* Forcibly Empty term_stack */
506
while ( IsNonNULL(pLeaf) && (! IsTrieRoot(pLeaf)) ) {
507
push_term((BTN_Symbol(pLeaf)));
508
pLeaf = BTN_Parent(pLeaf);
512
/*----------------------------------------------------------------------*/
515
* Given a hook to an answer-list node, returns the answer contained in
516
* that node and updates the hook to the next node in the chain.
518
BTNptr get_next_trie_solution(ALNptr *NextPtrPtr)
522
TempPtr = ALN_Answer(*NextPtrPtr);
523
*NextPtrPtr = ALN_Next(*NextPtrPtr);
527
/*----------------------------------------------------------------------*/
529
#define rec_macro_make_heap_term(Macro_addr) { \
531
while(addr_stack_pointer) { \
532
Macro_addr = (CPtr)pop_addr; \
534
switch( TrieSymbolType(xtemp2) ) { \
535
case XSB_TrieVar: { \
536
int index = DecodeTrieVar(xtemp2); \
537
if (IsNewTrieVar(xtemp2)) { \
538
safe_assign(var_addr,index,Macro_addr,var_addr_arraysz); \
539
num_heap_term_vars++; \
541
else if (IsNewTrieAttv(xtemp2)) { \
542
safe_assign(var_addr,index, \
543
(CPtr) makeattv(hreg),var_addr_arraysz); \
544
num_heap_term_vars++; \
545
new_heap_free(hreg); \
549
*Macro_addr = (Cell) var_addr[index]; \
555
*Macro_addr = xtemp2; \
558
*Macro_addr = (Cell) makelist(hreg); \
564
*Macro_addr = (Cell) makecs(hreg); \
565
xtemp2 = (Cell) DecodeTrieFunctor(xtemp2); \
567
rArity = (int) get_arity((Psc) xtemp2); \
568
for (rj= rArity; rj >= 1; rj --) { \
569
push_addr(hreg+rj); \
575
xsb_abort("Bad tag in macro_make_heap_term"); \
579
if (top_of_localstk < top_of_heap) xsb_abort("Heap overflow: should expand"); \
582
/*----------------------------------------------------------------------*/
584
#define macro_make_heap_term(ataddr,ret_val,dummy_addr) { \
587
switch( TrieSymbolType(xtemp2) ) { \
588
case XSB_TrieVar: { \
589
int index = DecodeTrieVar(xtemp2); \
590
if (IsNewTrieVar(xtemp2)) { /* diff with CHAT - Kostis */ \
591
safe_assign(var_addr,index,ataddr,var_addr_arraysz); \
592
num_heap_term_vars++; \
594
else if (IsNewTrieAttv(xtemp2)) { \
595
safe_assign(var_addr, index, \
596
(CPtr) makeattv(hreg),var_addr_arraysz); \
597
num_heap_term_vars++; \
598
new_heap_free(hreg); \
601
rec_macro_make_heap_term(dummy_addr); \
603
ret_val = (Cell) var_addr[index]; \
612
ret_val = (Cell) makelist(hreg) ; \
616
rec_macro_make_heap_term(dummy_addr); \
619
ret_val = (Cell) makecs(hreg); \
620
xtemp2 = (Cell) DecodeTrieFunctor(xtemp2); \
622
mArity = (int) get_arity((Psc) xtemp2); \
623
for (mj= mArity; mj >= 1; mj--) { \
624
push_addr(hreg+mj); \
628
rec_macro_make_heap_term(dummy_addr); \
631
xsb_abort("Bad tag in macro_make_heap_term"); \
634
if (top_of_localstk < top_of_heap) xsb_abort("Heap overflow: should expand"); \
637
/*----------------------------------------------------------------------*/
639
#define recvariant_trie(flag,TrieType) { \
642
while (!pdlempty ) { \
643
xtemp1 = (CPtr) pdlpop; \
644
XSB_CptrDeref(xtemp1); \
645
tag = cell_tag(xtemp1); \
649
if (! IsStandardizedVariable(xtemp1)) { \
650
StandardizeAndTrailVariable(xtemp1,ctr); \
651
item = EncodeNewTrieVar(ctr); \
652
one_node_chk_ins(flag, item, TrieType); \
655
item = IndexOfStdVar(xtemp1); \
656
item = EncodeTrieVar(item); \
657
one_node_chk_ins(flag, item, TrieType); \
663
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), TrieType); \
666
one_node_chk_ins(flag, EncodeTrieList(xtemp1), TrieType); \
667
pdlpush(cell(clref_val(xtemp1)+1)); \
668
pdlpush(cell(clref_val(xtemp1))); \
671
psc = (Psc) follow(cs_val(xtemp1)); \
672
item = makecs(psc); \
673
one_node_chk_ins(flag, item, TrieType); \
674
for (j = get_arity(psc); j>=1 ; j--) { \
675
pdlpush(cell(clref_val(xtemp1)+j)); \
679
/* Now xtemp1 can only be the first occurrence of an attv */ \
680
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */ \
681
StandardizeAndTrailVariable(xtemp1, ctr); \
682
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), INTERN_TRIE_TT); \
684
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */ \
687
xsb_abort("Bad type tag in recvariant_trie...\n"); \
693
/*----------------------------------------------------------------------*/
696
* This is a special version of recvariant_trie(), and it is only used by
697
* variant_answer_search(). The only difference between this and
698
* recvariant_trie() is that this version will save the answer
699
* substitution factor into the heap (see the following lines):
702
* bind_ref(xtemp1, hreg);
706
#define recvariant_trie_ans_subsf(flag,TrieType) { \
709
while (!pdlempty ) { \
710
xtemp1 = (CPtr) pdlpop; \
711
XSB_CptrDeref(xtemp1); \
712
tag = cell_tag(xtemp1); \
716
if (! IsStandardizedVariable(xtemp1)){ \
718
bind_ref(xtemp1, hreg); \
720
StandardizeAndTrailVariable(xtemp1,ctr); \
721
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),TrieType); \
724
one_node_chk_ins(flag, \
725
EncodeTrieVar(IndexOfStdVar(xtemp1)), \
732
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), TrieType); \
735
one_node_chk_ins(flag, EncodeTrieList(xtemp1), TrieType); \
736
pdlpush(cell(clref_val(xtemp1)+1)); \
737
pdlpush(cell(clref_val(xtemp1))); \
740
psc = (Psc) follow(cs_val(xtemp1)); \
741
item = makecs(psc); \
742
one_node_chk_ins(flag, item, TrieType); \
743
for (j = get_arity(psc); j>=1 ; j--) { \
744
pdlpush(cell(clref_val(xtemp1)+j)); \
748
/* Now xtemp1 can only be the first occurrence of an attv */ \
749
/* *(hreg++) = (Cell) xtemp1; */ \
750
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */ \
751
StandardizeAndTrailVariable(xtemp1, ctr); \
752
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), TrieType); \
754
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */ \
757
xsb_abort("Bad type tag in recvariant_trie_ans_subsf...\n"); \
764
#include "term_psc_xsb_i.h"
765
#include "ptoc_tag_xsb_i.h"
769
* Called in SLG instruction `new_answer_dealloc', variant_answer_search()
770
* checks if the answer has been returned before and, if not, inserts it
771
* into the answer trie. Here, `sf_size' is the number of variables in the
772
* substitution factor of the called subgoal, `attv_num' is the number of
773
* attributed variables in the call, `cptr' is the pointer to the
774
* substitution factor, and `subgoal_ptr' is the subgoal frame of the
775
* call. At the end of this function, `flagptr' tells if the answer
776
* has been returned before.
778
* The returned value of this function is the leaf of the answer trie.
781
BTNptr variant_answer_search(CTXTdeclc int sf_size, int attv_num, CPtr cptr,
782
VariantSF subgoal_ptr, xsbBool *flagptr) {
787
Cell tag = XSB_FREE, item, tmp_var;
790
BTNptr Paren, *GNodePtrPtr;
792
ans_chk_ins++; /* Counter (answers checked & inserted) */
794
VarEnumerator_trail_top = (CPtr *)(& VarEnumerator_trail[0]) - 1;
797
if ( IsNULL(subg_ans_root_ptr(subgoal_ptr)) ) {
800
retSymbol = EncodeTriePSC(get_ret_psc(sf_size));
802
retSymbol = EncodeTrieConstant(makestring(get_ret_string()));
803
subg_ans_root_ptr(subgoal_ptr) =
804
newBasicAnswerTrie(CTXTc retSymbol, (CPtr) subgoal_ptr,
805
BASIC_ANSWER_TRIE_TT);
807
Paren = subg_ans_root_ptr(subgoal_ptr);
808
GNodePtrPtr = &BTN_Child(Paren);
810
/* Documentation rewritten by TLS:
811
* To properly generate instructions for attributed variables, you
812
* need to know which attributed variables are identical to those in
813
* the call, and which represent new bindings to attributed or vanilla
814
* variables. The marking below binds binds the VAR part of the
815
* attvs to an element of VarEnumerator[]. When the for() loop
816
* dereferences these variables they can be recognized as pointing
817
* into VarEnumerator, and a trie_xxx_val instruction will be
818
* generated for them. Other attvs will dereference elsewhere and
819
* will generate a trie_xxx_attv instruction. Note that in doing
820
* this, attributes in the call will not need to be re-entered in
823
* According to Bao's algorithm, in order for trie instructions for
824
* completed tables to work for attvs, attvs in the call must be
825
* traversed before the main loop and bound to elements of
826
* varEnumerator so that the trie_xxx_val instructions can recognize
827
* them and avoid interrupts. As a result, both here and in the tabletry
828
* setup for completed tables, the substitution factor is traversed
829
* and the attvs set to the lower portion of varEnumerator. To save
830
* time, this is only done when there is at least one attv in
831
* the call (attv_num > 0). �
834
for (i = 0; i < sf_size; i++) {
835
tmp_var = cell(cptr - i);
836
if (isattv(tmp_var)) {
837
xtemp1 = clref_val(tmp_var); /* the VAR part */
838
if (xtemp1 == (CPtr) cell(xtemp1)) { /* this attv is not changed */
839
StandardizeAndTrailVariable(xtemp1, ctr);
844
/* now ctr should be equal to attv_num */
848
for (i = 0; i < sf_size; i++) {
849
xtemp1 = (CPtr) (cptr - i); /* One element of VarsInCall. It might
850
* have been bound in the answer for
853
XSB_CptrDeref(xtemp1);
854
tag = cell_tag(xtemp1);
858
if (! IsStandardizedVariable(xtemp1)) {
860
* Note that unlike variant_call_search(), vas() trails
861
* variables (by using VarEnumerator_trail_top, rather than
862
* full SLG-WAM trailing. Thus, if this is the first
863
* occurrence of this variable, then:
865
* StandardizeAndTrailVariable(xtemp1, ctr)
867
* bld_ref(xtemp1, VarEnumerator[ctr]);
868
* *(++VarEnumerator_trail_top) = xtemp1
870
* By doing this, all the variables appearing in the answer
871
* are bound to elements in VarEnumerator[], and each element
872
* in VarEnumerator[] is a free variable itself. vcs() was
873
* able to avoid the trail because all variables were placed
874
* on the substitution factor; variables encountered in an
875
* answer substitution can be anywhere on the heap. Also
876
* note that this function uses the pdl stack rather than
877
* reg_array, as does vsc().
878
* The variables will be used in
879
* delay_chk_insert() (in function do_delay_stuff()).
882
#ifndef IGNORE_DELAYVAR
883
bld_free(hreg); // make sure there is no pointer from heap to local stack.
884
bind_ref(xtemp1, hreg);
887
StandardizeAndTrailVariable(xtemp1,ctr);
888
item = EncodeNewTrieVar(ctr);
889
one_node_chk_ins(flag, item, BASIC_ANSWER_TRIE_TT);
892
item = IndexOfStdVar(xtemp1);
893
item = EncodeTrieVar(item);
894
one_node_chk_ins(flag, item, BASIC_ANSWER_TRIE_TT);
900
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1),
901
BASIC_ANSWER_TRIE_TT);
904
one_node_chk_ins(flag, EncodeTrieList(xtemp1), BASIC_ANSWER_TRIE_TT);
905
pdlpush(cell(clref_val(xtemp1)+1));
906
pdlpush(cell(clref_val(xtemp1)));
907
#ifndef IGNORE_DELAYVAR
908
recvariant_trie_ans_subsf(flag, BASIC_ANSWER_TRIE_TT);
910
recvariant_trie(flag, BASIC_ANSWER_TRIE_TT);
914
psc = (Psc)follow(cs_val(xtemp1));
916
one_node_chk_ins(flag, item, BASIC_ANSWER_TRIE_TT);
917
for (j = get_arity(psc); j >= 1 ; j--) {
918
pdlpush(cell(clref_val(xtemp1)+j));
920
#ifndef IGNORE_DELAYVAR
921
recvariant_trie_ans_subsf(flag, BASIC_ANSWER_TRIE_TT);
923
recvariant_trie(flag, BASIC_ANSWER_TRIE_TT);
927
/* Now xtemp1 can only be the first occurrence of an attv */
928
// *(hreg++) = (Cell) xtemp1;
929
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */
931
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
932
* later occurrences of this attv will look like a regular variable
933
* (after dereferencing).
935
StandardizeAndTrailVariable(xtemp1, ctr);
936
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), BASIC_ANSWER_TRIE_TT);
938
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */
939
#ifndef IGNORE_DELAYVAR
940
recvariant_trie_ans_subsf(flag, BASIC_ANSWER_TRIE_TT);
942
recvariant_trie(flag, BASIC_ANSWER_TRIE_TT);
946
xsb_abort("Bad type tag in variant_answer_search()");
951
#ifndef IGNORE_DELAYVAR
953
* Put the substitution factor of the answer into a term ret/n (if
954
* the sf_size of the substitution factor is 0, then put integer 0
955
* into cell ans_var_pos_reg).
957
* Notice that simple_table_undo_bindings in pre-1.9 version of XSB
958
* has been removed here, because all the variable bindings of this
959
* answer will be used in do_delay_stuff() immediatly after the
960
* return of vas() when we build the delay list for this answer.
963
bld_int(ans_var_pos_reg, 0);
965
bld_functor(ans_var_pos_reg, get_ret_psc(ctr));
966
#else /* IGNORE_DELAYVAR */
967
undo_answer_bindings(CTXT);
971
* Save the number of variables in the answer, i.e. the sf_size of
972
* the substitution factor of the answer, into `AnsVarCtr'.
976
#ifdef DEBUG_DELAYVAR
977
xsb_dbgmsg((LOG_DEBUG,">>>> [V] AnsVarCtr = %d", AnsVarCtr));
980
/* if there is no term to insert, an ESCAPE node has to be created/found */
983
one_node_chk_ins(flag, ESCAPE_NODE_SYMBOL, BASIC_ANSWER_TRIE_TT);
984
Instr(Paren) = trie_proceed;
988
* If an insertion was performed, do some maintenance on the new leaf,
989
* and place the answer handle onto the answer list.
993
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
996
New_ALN(subgoal_ptr,answer_node,Paren,NULL);
997
SF_AppendNewAnswer(subgoal_ptr,answer_node);
1005
* undo_answer_bindings() has the same functionality of
1006
* simple_table_undo_bindings. It is called just after do_delay_stuff(),
1007
* and do_delay_stuff() is called after variant_answer_search (in
1008
* new_answer_dealloc)
1010
* In XSB 1.8.1, simple_table_undo_bindings is called in
1011
* variant_answer_search(). But to handle variables in delay list in
1012
* do_delay_stuff() , we need the variable binding information got from
1013
* variant_answer_search(). So we have to take simple_table_undo_bindings
1014
* out of variant_answer_search() and call it after do_delay_stuff() is
1018
void undo_answer_bindings(CTXTdecl) {
1019
simple_table_undo_bindings;
1023
* Function delay_chk_insert() is called only from intern_delay_element()
1024
* to create the delay trie for the corresponding delay element. This
1025
* delay trie contains the substitution factor of the answer to the subgoal
1026
* call of this delay element. Its leaf node will be saved as a field,
1027
* de_subs_fact_leaf, in the delay element.
1029
* This function is closely related to variant_answer_search(), because it
1030
* uses the value of AnsVarCtr that is set in variant_answer_search(). The
1031
* body of this function is almost the same as the core part of
1032
* variant_answer_search(), except that `ctr', the counter of the variables
1033
* in the answer, starts from AnsVarCtr. Initially, before the first delay
1034
* element in the delay list of a subgoal (say p/2), is interned, AnsVarCtr
1035
* is the number of variables in the answer for p/2 and it was set in
1036
* variant_answer_search() when this answer was returned. Then, AnsVarCtr
1037
* will be dynamically increased as more and more delay elements for p/2
1040
* After variant_answer_search() is finished, VarEnumerator[] contains the
1041
* variables in the head of the corresponding clause for p/2. When we call
1042
* delay_chk_insert() to intern the delay list for p/2, VarEnumerator[]
1043
* will be used again to bind the variables that appear in the body.
1044
* Because we have to check if a variable in a delay element of p/2 is
1045
* already in the head, the old bindings of variables to VarEnumerator[]
1046
* are still needed. So undo_answer_bindings has to be delayed.
1048
* In the arguments, `arity' is the arity of the the answer substitution
1049
* factor, `cptr' points to the first field of term ret/n (the answer
1050
* substitution factor), `hook' is a pointer to a location where the top of
1051
* this delay trie will become anchored. Since these delay "tries" only
1052
* occur as single paths, there is currently no need for a root node.
1055
BTNptr delay_chk_insert(CTXTdeclc int arity, CPtr cptr, CPtr *hook)
1060
int i, j, tag = XSB_FREE, flag = 1;
1062
BTNptr Paren, *GNodePtrPtr;
1064
#ifdef DEBUG_DELAYVAR
1065
xsb_dbgmsg((LOG_DEBUG,">>>> start delay_chk_insert()"));
1069
GNodePtrPtr = (BTNptr *) hook;
1073
#ifdef DEBUG_DELAYVAR
1074
xsb_dbgmsg((LOG_DEBUG,">>>> [D1] AnsVarCtr = %d", AnsVarCtr));
1077
for (i = 0; i<arity; i++) {
1079
* Notice: the direction of saving the variables in substitution
1080
* factors has been changed. Because Prasad saves the substitution
1081
* factors in CP stack (--VarPosReg), but I save them in heap
1082
* (hreg++). So (cptr - i) is changed to (cptr + i) in the
1085
xtemp1 = (CPtr) (cptr + i);
1086
xsb_dbgmsg((LOG_BD, "arg[%d] = %x ",i, xtemp1));
1087
XSB_CptrDeref(xtemp1);
1088
dbg_printterm(LOG_BD,stddbg,(unsigned int)xtemp1,25);
1089
xsb_dbgmsg((LOG_BD, "\n"));
1090
tag = cell_tag(xtemp1);
1094
if (! IsStandardizedVariable(xtemp1)) {
1095
StandardizeAndTrailVariable(xtemp1,ctr);
1096
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),
1101
one_node_chk_ins(flag,
1102
EncodeTrieVar(IndexOfStdVar(xtemp1)),
1109
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), DELAY_TRIE_TT);
1112
one_node_chk_ins(flag, EncodeTrieList(xtemp1), DELAY_TRIE_TT);
1113
pdlpush(cell(clref_val(xtemp1)+1));
1114
pdlpush(cell(clref_val(xtemp1)));
1115
recvariant_trie(flag,DELAY_TRIE_TT);
1118
one_node_chk_ins(flag, makecs(follow(cs_val(xtemp1))),DELAY_TRIE_TT);
1119
for (j = get_arity((Psc)follow(cs_val(xtemp1))); j >= 1 ; j--) {
1120
pdlpush(cell(clref_val(xtemp1)+j));
1122
recvariant_trie(flag,DELAY_TRIE_TT);
1125
// /* Now xtemp1 can only be the first occurrence of an attv */
1126
// *(hreg++) = (Cell) xtemp1;
1127
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */
1129
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
1130
* later occurrences of this attv will look like a regular variable
1131
* (after dereferencing).
1133
if (! IsStandardizedVariable(xtemp1)) {
1134
StandardizeAndTrailVariable(xtemp1, ctr);
1135
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), DELAY_TRIE_TT);
1139
one_node_chk_ins(flag,
1140
EncodeTrieVar(IndexOfStdVar(xtemp1)),
1143
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */
1144
recvariant_trie(flag, DELAY_TRIE_TT);
1147
xsb_abort("Bad type tag in delay_chk_insert()\n");
1153
#ifdef DEBUG_DELAYVAR
1154
xsb_dbgmsg((LOG_DEBUG,">>>> [D2] AnsVarCtr = %d", AnsVarCtr));
1158
* If an insertion was performed, do some maintenance on the new leaf.
1161
MakeLeafNode(Paren);
1162
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
1165
xsb_dbgmsg((LOG_BD, "----------------------------- Exit\n"));
1169
/*----------------------------------------------------------------------*/
1170
/* for each variable in call, builds its binding on the heap. */
1171
/*----------------------------------------------------------------------*/
1174
* Expects that the path in the trie -- to which the variables (stored in
1175
* the vector `cptr') are to be unified -- has been pushed onto the
1178
static void load_solution_from_trie(CTXTdeclc int arity, CPtr cptr)
1181
CPtr xtemp1, Dummy_Addr;
1182
Cell returned_val, xtemp2;
1184
for (i=0; i<arity; i++) {
1185
xtemp1 = (CPtr) (cptr-i);
1186
XSB_CptrDeref(xtemp1);
1187
macro_make_heap_term(xtemp1,returned_val,Dummy_Addr);
1188
if (xtemp1 != (CPtr)returned_val) {
1189
if (isref(xtemp1)) { /* a regular variable */
1190
dbind_ref(xtemp1,returned_val);
1192
else { /* an XSB_ATTV */
1193
/* Bind the variable part of xtemp1 to returned_val */
1194
add_interrupt(CTXTc cell(((CPtr)dec_addr(xtemp1) + 1)), returned_val);
1195
dbind_ref((CPtr) dec_addr(xtemp1), returned_val);
1202
/*----------------------------------------------------------------------*/
1205
* Unifies the path in the interned trie identified by `Leaf' with the term
1206
* `term'. It appears that `term' is expected to be an unbound variable.
1207
* Also, `Root' does not appear to be used.
1209
static void bottomupunify(CTXTdeclc Cell term, BTNptr Root, BTNptr Leaf)
1212
Cell returned_val, xtemp2;
1216
num_heap_term_vars = 0;
1217
follow_par_chain(CTXTc Leaf);
1220
macro_make_heap_term(gen,returned_val,Dummy_Addr);
1221
bld_ref(gen,returned_val);
1223
for(i = 0; i < num_heap_term_vars; i++){
1224
var_regs[i] = var_addr[i];
1227
* global_num_vars is needed by get_lastnode_cs_retskel() (see
1228
* trie_interned/4 in intern.P).
1230
* Last_Nod_Sav is also needed by get_lastnode_cs_retskel(). We can
1233
global_num_vars = num_vars_in_var_regs = num_heap_term_vars - 1;
1234
Last_Nod_Sav = Leaf;
1237
/*----------------------------------------------------------------------*/
1240
* Used with tries created via the builtin trie_intern.
1243
#ifndef MULTI_THREAD
1244
extern BTNptr *Set_ArrayPtr;
1247
xsbBool bottom_up_unify(CTXTdecl)
1254
leaf = (BTNptr) ptoc_int(CTXTc 3);
1255
if( IsDeletedNode(leaf) )
1258
term = ptoc_tag(CTXTc 1);
1259
rootidx = ptoc_int(CTXTc 2);
1260
root = Set_ArrayPtr[rootidx];
1261
bottomupunify(CTXTc term, root, leaf);
1265
/*----------------------------------------------------------------------*/
1268
* `TriePtr' is a leaf in the answer trie, and `cptr' is a vector of
1269
* variables for receiving the substitution.
1271
void load_solution_trie(CTXTdeclc int arity, int attv_num, CPtr cptr, BTNptr TriePtr)
1275
num_heap_term_vars = 0;
1277
/* Initialize var_addr[] as the attvs in the call. */
1279
for (xtemp = cptr; xtemp > cptr - arity; xtemp--) {
1280
if (isattv(cell(xtemp))) {
1281
// var_addr[num_heap_term_vars] = (CPtr) cell(xtemp);
1282
safe_assign(var_addr,num_heap_term_vars,(CPtr) cell(xtemp),var_addr_arraysz);
1283
num_heap_term_vars++;
1287
follow_par_chain(CTXTc TriePtr);
1288
load_solution_from_trie(CTXTc arity,cptr);
1292
/*----------------------------------------------------------------------*/
1294
void load_delay_trie(CTXTdeclc int arity, CPtr cptr, BTNptr TriePtr)
1297
follow_par_chain(CTXTc TriePtr);
1298
load_solution_from_trie(CTXTc arity,cptr);
1302
/*----------------------------------------------------------------------*/
1304
#define recvariant_call(flag,TrieType,xtemp1) { \
1307
while (!pdlempty) { \
1308
xtemp1 = (CPtr) pdlpop; \
1309
XSB_CptrDeref(xtemp1); \
1310
switch(tag = cell_tag(xtemp1)) { \
1313
if (! IsStandardizedVariable(xtemp1)) { \
1314
*(--VarPosReg) = (Cell) xtemp1; \
1315
StandardizeVariable(xtemp1,ctr); \
1316
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),TrieType); \
1319
one_node_chk_ins(flag, EncodeTrieVar(IndexOfStdVar(xtemp1)), \
1326
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), TrieType); \
1329
one_node_chk_ins(flag, EncodeTrieList(xtemp1), TrieType); \
1330
pdlpush( cell(clref_val(xtemp1)+1) ); \
1331
pdlpush( cell(clref_val(xtemp1)) ); \
1334
psc = (Psc) follow(cs_val(xtemp1)); \
1335
item = makecs(psc); \
1336
one_node_chk_ins(flag, item, TrieType); \
1337
for (j=get_arity(psc); j>=1; j--) { \
1338
pdlpush(cell(clref_val(xtemp1)+j)); \
1342
/* Now xtemp1 can only be the first occurrence of an attv */ \
1343
*(--VarPosReg) = (Cell) xtemp1; \
1344
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */ \
1345
StandardizeVariable(xtemp1, ctr); \
1346
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), TrieType); \
1347
attv_ctr++; ctr++; \
1348
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */ \
1351
xsb_abort("Bad type tag in recvariant_call...\n"); \
1357
/*----------------------------------------------------------------------*/
1361
* To me it seems this function is written in an overly general way.
1362
* I dont see a real need to encapsulate all of its input and output
1363
* as it is only called once, in tabletry. What's lost is:
1364
* cptr is simply a pointer to the reg_array, cptr = reg+1
1365
* VarPosReg is top_of_cpstack. This can cause confusion since later in
1366
* table_call_search (which calls this function) the substitution
1367
* factor is copied to the heap.
1369
* In addition, the manner in which attributed variables are handled
1370
* gives rise to some special features in the code. When adding an
1371
* answer, it is not straightforward to determine whether a binding
1372
* to a substitution factor was made in the original call or as part
1373
* of program clause resolution. variant_call_search() creates a
1374
* substitution factor on the choice point stack. Immediately after
1375
* variant_call_search() returns, table_call_search() will copy the
1376
* substitution factor from the choice point stack to the heap. It
1377
* can then be determined whether attributed variables are old or new
1378
* by comparing the value of a cell in the choice point stack to the
1379
* corresponding value in the heap. If they are the same, the
1380
* attributed variable was in the call, and a trie_xxx_val
1381
* instruction can be used. If not, other actions must be taken --
1382
* generating either a trie_xxx_val or trie_xxx_attv.
1384
* While most of this happens in later functions, certain
1385
* features of vcs() can be accounted for by these later actions.
1386
* For instance, each local variable is copied to the heap in vcs().
1387
* This is to avoid pointers from the heap substitution factor (once
1388
* it is created) into the local stack.
1393
* Searches/inserts a subgoal call structure into a subgoal call trie.
1394
* During search/insertion, the variables of the subgoal call are
1395
* pushed on top of the CP stack (through VarPosReg), along with the #
1396
* of variables that were pushed. This forms the substitution factor.
1397
* Prolog variables are standardized during this process to recognize
1398
* multiple (nonlinear) occurences. They must be reset to an unbound
1399
* state before termination.
1401
* Important variables:
1402
* Paren - to be set to point to inserted term's leaf
1403
* VarPosReg - pointer to top of CPS; place to put the substitution factor
1404
* in high-to-low memory format.
1405
* GNodePtrPtr - Points to the parent-internal-structure's
1406
* "child" or "NODE_link" field. It's a place to anchor any newly
1408
* ctr - contains the number of distinct variables found
1410
* Pay careful attention to the expected argument vector accepted by this
1411
* function. It actually points one Cell *before* the term vector! Notice
1412
* the treatment of "cptr" as these terms are inspected.
1415
void variant_call_search(CTXTdeclc TabledCallInfo *call_info,
1416
CallLookupResults *results)
1420
int arity, i, j, flag = 1;
1421
Cell tag = XSB_FREE, item;
1422
CPtr cptr, VarPosReg, tVarPosReg;
1424
BTNptr Paren, *GNodePtrPtr;
1427
Paren = TIF_CallTrie(CallInfo_TableInfo(*call_info));
1428
GNodePtrPtr = &BTN_Child(Paren);
1429
arity = CallInfo_CallArity(*call_info);
1430
/* cptr is set to point to the reg_array */
1431
cptr = CallInfo_Arguments(*call_info);
1432
tVarPosReg = VarPosReg = CallInfo_VarVectorLoc(*call_info);
1435
for (i = 0; i < arity; i++) {
1436
xsb_dbgmsg((LOG_DEBUG,">>>> (argument %d)",i+1));
1437
call_arg = (CPtr) (cptr + i); /* Note! */
1438
XSB_CptrDeref(call_arg);
1439
tag = cell_tag(call_arg);
1443
if (! IsStandardizedVariable(call_arg)) {
1445
/* Call_arg is now a dereferenced register value. If it
1446
* points to a local variable, make both the local variable
1447
* and call_arg point to a new free variable in the heap.
1448
* As noted in the documentation at the start of this function,
1449
* this is to support attributed variables in tabling.
1452
xsb_dbgmsg((LOG_DEBUG," new variable ctr = %d)",ctr));
1454
if (top_of_localstk <= call_arg &&
1455
call_arg <= (CPtr) glstack.high - 1) {
1457
bind_ref(call_arg, hreg);
1461
* Make VarPosReg, which points to the top of the choice point
1462
* stack, point to call_arg, which now points a free variable in the
1463
* heap. Make that heap free variable point to the
1464
* VarEnumerator array, via StandardizeVariable. The
1465
* VarEnumerator array contains variables that point to
1466
* themselves (init'd in init_trie_aux_areas()). vcs() does
1467
* not change bindings in the VarEnumerator array -- it just
1468
* changes bindings of heap variables that point into it.
1470
*(--VarPosReg) = (Cell) call_arg;
1471
StandardizeVariable(call_arg,ctr);
1472
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),
1476
one_node_chk_ins(flag,EncodeTrieVar(IndexOfStdVar(call_arg)),CALL_TRIE_TT);
1482
one_node_chk_ins(flag, EncodeTrieConstant(call_arg), CALL_TRIE_TT);
1485
one_node_chk_ins(flag, EncodeTrieList(call_arg), CALL_TRIE_TT);
1486
pdlpush(cell(clref_val(call_arg)+1));
1487
pdlpush(cell(clref_val(call_arg)));
1488
recvariant_call(flag,CALL_TRIE_TT,call_arg);
1491
psc = (Psc)follow(cs_val(call_arg));
1493
one_node_chk_ins(flag, item, CALL_TRIE_TT);
1494
for (j=get_arity(psc); j>=1 ; j--) {
1495
pdlpush(cell(clref_val(call_arg)+j));
1497
recvariant_call(flag,CALL_TRIE_TT,call_arg);
1500
/* call_arg is derefed register value pointing to heap. Make
1501
the subst factor CP-stack pointer, VarPosReg, point to it. */
1502
*(--VarPosReg) = (Cell) call_arg;
1503
xsb_dbgmsg((LOG_TRIE,"In VSC: attv deref'd reg %x; val: %x into AT: %x",
1504
call_arg,clref_val(call_arg),VarPosReg));
1505
call_arg = clref_val(call_arg); /* the VAR part of the attv */
1507
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
1508
* later occurrences of this attv will look like a regular variable
1509
* (after dereferencing).
1511
StandardizeVariable(call_arg, ctr);
1512
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), CALL_TRIE_TT);
1514
pdlpush(cell(call_arg+1)); /* the ATTR part of the attv */
1515
recvariant_call(flag, CALL_TRIE_TT, call_arg);
1518
xsb_abort("Bad type tag in variant_call_search...\n");
1524
one_node_chk_ins(flag, ESCAPE_NODE_SYMBOL, CALL_TRIE_TT);
1525
Instr(Paren) = trie_proceed;
1529
* If an insertion was performed, do some maintenance on the new leaf.
1533
MakeLeafNode(Paren);
1534
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
1537
cell(--VarPosReg) = makeint(attv_ctr << 16 | ctr);
1539
* "Untrail" any variable that used to point to VarEnumerator. For
1540
* variables, note that *VarPosReg is the address of a cell in the
1541
* heap. To reset that variable, we make that address free.
1542
* Similarly, *VarPosReg may contain the (encoded) address of an
1543
* attv on the heap. In this case, we make the VAR part of that
1544
* attv point to itself. The actual value in VarPosReg (i.e. the
1545
* of a substitution factor) doesn't change in either case.
1547
while (--tVarPosReg > VarPosReg) {
1548
if (isref(*tVarPosReg)) /* a regular variable */
1549
ResetStandardizedVariable(*tVarPosReg);
1550
else /* an XSB_ATTV */
1551
ResetStandardizedVariable(clref_val(*tVarPosReg));
1554
CallLUR_Leaf(*results) = Paren;
1555
CallLUR_Subsumer(*results) = CallTrieLeaf_GetSF(Paren);
1556
CallLUR_VariantFound(*results) = flag;
1557
CallLUR_VarVector(*results) = VarPosReg;
1561
/*----------------------------------------------------------------------*/
1563
static void remove_calls_and_returns(CTXTdeclc VariantSF CallStrPtr)
1567
/* Delete the call entry
1568
--------------------- */
1569
SET_TRIE_ALLOCATION_TYPE_SF(CallStrPtr);
1570
delete_branch(CTXTc subg_leaf_ptr(CallStrPtr),
1571
&TIF_CallTrie(subg_tif_ptr(CallStrPtr)));
1573
/* Delete its answers
1574
------------------ */
1575
for ( pALN = subg_answers(CallStrPtr); IsNonNULL(pALN);
1576
pALN = ALN_Next(pALN) )
1577
delete_branch(CTXTc ALN_Answer(pALN), &subg_ans_root_ptr(CallStrPtr));
1579
/* Delete the table entry
1580
---------------------- */
1581
free_answer_list(CallStrPtr);
1582
FreeProducerSF(CallStrPtr);
1585
void remove_incomplete_tries(CTXTdeclc CPtr bottom_parameter)
1587
xsbBool warned = FALSE;
1588
VariantSF CallStrPtr;
1590
while (openreg < bottom_parameter) {
1591
CallStrPtr = (VariantSF)compl_subgoal_ptr(openreg);
1592
if (!is_completed(CallStrPtr)) {
1593
if (warned == FALSE) {
1594
xsb_mesg("Removing incomplete tables...");
1595
// check_table_cut = FALSE; /* permit cuts over tables */
1598
remove_calls_and_returns(CTXTc CallStrPtr);
1600
openreg += COMPLFRAMESIZE;
1604
/*----------------------------------------------------------------------*/
1607
* For creating interned tries via buitin "trie_intern".
1610
BTNptr whole_term_chk_ins(CTXTdeclc Cell term, BTNptr *hook, int *flagptr)
1615
Cell tag = XSB_FREE, item;
1617
BTNptr Paren, *GNodePtrPtr;
1620
if ( IsNULL(*hook) )
1621
*hook = newBasicTrie(CTXTc EncodeTriePSC(get_intern_psc()),INTERN_TRIE_TT);
1623
GNodePtrPtr = &BTN_Child(Paren);
1625
xtemp1 = (CPtr) term;
1626
XSB_CptrDeref(xtemp1);
1627
tag = cell_tag(xtemp1);
1629
VarEnumerator_trail_top = (CPtr *)(& VarEnumerator_trail[0]) - 1;
1635
if (! IsStandardizedVariable(xtemp1)) {
1636
StandardizeAndTrailVariable(xtemp1,ctr);
1637
one_node_chk_ins(flag,EncodeNewTrieVar(ctr),
1641
one_node_chk_ins(flag,
1642
EncodeTrieVar(IndexOfStdVar(xtemp1)),
1649
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), INTERN_TRIE_TT);
1652
one_node_chk_ins(flag, EncodeTrieList(xtemp1), INTERN_TRIE_TT);
1653
pdlpush(cell(clref_val(xtemp1)+1));
1654
pdlpush(cell(clref_val(xtemp1)));
1655
recvariant_trie(flag,INTERN_TRIE_TT);
1658
one_node_chk_ins(flag, makecs(follow(cs_val(xtemp1))),INTERN_TRIE_TT);
1659
for (j = get_arity((Psc)follow(cs_val(xtemp1))); j >= 1 ; j--) {
1660
pdlpush(cell(clref_val(xtemp1)+j));
1662
recvariant_trie(flag,INTERN_TRIE_TT);
1665
/* Now xtemp1 can only be the first occurrence of an attv */
1666
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */
1668
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
1669
* later occurrences of this attv will look like a regular variable
1670
* (after dereferencing).
1672
StandardizeAndTrailVariable(xtemp1, ctr);
1673
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), INTERN_TRIE_TT);
1675
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */
1676
recvariant_trie(flag, INTERN_TRIE_TT);
1679
xsb_abort("Bad type tag in whole_term_check_ins()");
1683
* If an insertion was performed, do some maintenance on the new leaf.
1686
MakeLeafNode(Paren);
1687
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
1691
* var_regs[] is used to construct the last argument of trie_intern/5
1692
* (Skel). This is done in construct_ret(), which is called in
1693
* get_lastnode_cs_retskel().
1695
for (j = 0; j < ctr; j++) var_regs[j] = VarEnumerator_trail[j];
1697
* Both global_num_vars and Last_Nod_Sav are needed by
1698
* get_lastnode_cs_retskel() (see trie_intern/5 in intern.P).
1700
global_num_vars = num_vars_in_var_regs = ctr - 1;
1701
Last_Nod_Sav = Paren;
1702
simple_table_undo_bindings;
1704
/* if node was deleted, then return 0 to indicate that the insertion took
1705
place conceptually (even if not physically */
1706
if (IsDeletedNode(Paren)) {
1708
undelete_branch(Paren);
1715
/*----------------------------------------------------------------------*/
1716
/* one_term_chk_ins(termptr,hook,flag) */
1717
/*----------------------------------------------------------------------*/
1720
* For creating asserted tries with builtin "trie_assert".
1723
BTNptr one_term_chk_ins(CTXTdeclc CPtr termptr, BTNptr root, int *flagptr)
1729
Cell tag = XSB_FREE, item;
1732
BTNptr Paren, *GNodePtrPtr;
1734
psc = term_psc((prolog_term)termptr);
1735
arity = get_arity(psc);
1736
cptr = (CPtr)cs_val(termptr);
1738
VarEnumerator_trail_top = (CPtr *)(& VarEnumerator_trail[0]) - 1;
1741
* The value of `Paren' effects the "body" of the trie: nodes which
1742
* are created the first level down get this value in their parent
1743
* field. This could be a problem when deleting trie paths, as this
1744
* root needs to persist beyond the life of its body.
1747
GNodePtrPtr = &BTN_Child(root);
1748
for (i = 1; i<=arity; i++) {
1749
xtemp1 = (CPtr) (cptr + i);
1750
XSB_CptrDeref(xtemp1);
1751
tag = cell_tag(xtemp1);
1755
if (! IsStandardizedVariable(xtemp1)) {
1756
StandardizeAndTrailVariable(xtemp1,ctr);
1757
one_node_chk_ins(flag, EncodeNewTrieVar(ctr),
1761
one_node_chk_ins(flag,
1762
EncodeTrieVar(IndexOfStdVar(xtemp1)),
1769
one_node_chk_ins(flag, EncodeTrieConstant(xtemp1), ASSERT_TRIE_TT);
1772
one_node_chk_ins(flag, EncodeTrieList(xtemp1), ASSERT_TRIE_TT);
1773
pdlpush(cell(clref_val(xtemp1)+1));
1774
pdlpush(cell(clref_val(xtemp1)));
1775
recvariant_trie(flag,ASSERT_TRIE_TT);
1778
psc = (Psc) follow(cs_val(xtemp1));
1779
one_node_chk_ins(flag, makecs(psc),ASSERT_TRIE_TT);
1780
for (j = get_arity(psc); j >= 1 ; j--) {
1781
pdlpush(cell(clref_val(xtemp1)+j));
1783
recvariant_trie(flag,ASSERT_TRIE_TT);
1786
/* Now xtemp1 can only be the first occurrence of an attv */
1787
xtemp1 = clref_val(xtemp1); /* the VAR part of the attv */
1789
* Bind the VAR part of this attv to VarEnumerator[ctr], so all the
1790
* later occurrences of this attv will look like a regular variable
1791
* (after dereferencing).
1793
StandardizeAndTrailVariable(xtemp1, ctr);
1794
one_node_chk_ins(flag, EncodeNewTrieAttv(ctr), ASSERT_TRIE_TT);
1796
pdlpush(cell(xtemp1+1)); /* the ATTR part of the attv */
1797
recvariant_trie(flag, ASSERT_TRIE_TT);
1800
xsb_abort("Bad type tag in one_term_check_ins()");
1805
simple_table_undo_bindings;
1807
/* if there is no term to insert, an ESCAPE node has to be created/found */
1810
one_node_chk_ins(flag, ESCAPE_NODE_SYMBOL, ASSERT_TRIE_TT);
1811
Instr(Paren) = trie_proceed;
1815
* If an insertion was performed, do some maintenance on the new leaf.
1818
MakeLeafNode(Paren);
1819
TN_UpgradeInstrTypeToSUCCESS(Paren,tag);
1826
/*----------------------------------------------------------------------*/
1829
* This is builtin #150: TRIE_GET_RETURN
1832
byte *trie_get_returns(CTXTdeclc VariantSF sf, Cell retTerm) {
1834
BTNptr ans_root_ptr;
1836
#ifdef MULTI_THREAD_RWL
1844
#ifdef DEBUG_DELAYVAR
1845
xsb_dbgmsg((LOG_DEBUG,">>>> (at the beginning of trie_get_returns"));
1846
xsb_dbgmsg((LOG_DEBUG,">>>> num_vars_in_var_regs = %d)", num_vars_in_var_regs));
1849
if ( IsProperlySubsumed(sf) )
1850
ans_root_ptr = subg_ans_root_ptr(conssf_producer(sf));
1852
ans_root_ptr = subg_ans_root_ptr(sf);
1853
if ( IsNULL(ans_root_ptr) )
1854
return (byte *)&fail_inst;
1856
if ( isconstr(retTerm) )
1857
retSymbol = EncodeTrieFunctor(retTerm); /* ret/n rep as XSB_STRUCT */
1859
retSymbol = retTerm; /* ret/0 would be represented as a XSB_STRING */
1860
if ( retSymbol != BTN_Symbol(ans_root_ptr) )
1861
return (byte *)&fail_inst;
1863
num_vars_in_var_regs = -1;
1864
if ( isconstr(retTerm) ) {
1868
arity = get_arity(get_str_psc(retTerm));
1869
/* Initialize var_regs[] as the attvs in the call. */
1870
for (i = 0, cptr = clref_val(retTerm) + 1; i < arity; i++, cptr++) {
1871
if (isattv(cell(cptr)))
1872
var_regs[++num_vars_in_var_regs] = (CPtr) cell(cptr);
1874
/* now num_vars_in_var_regs should be attv_num - 1 */
1876
reg_arrayptr = reg_array -1;
1877
for (i = arity, cptr = clref_val(retTerm); i >= 1; i--) {
1878
pushreg(cell(cptr+i));
1881
#ifdef DEBUG_DELAYVAR
1882
xsb_dbgmsg((LOG_DEBUG,">>>> The end of trie_get_returns ==> go to answer trie"));
1884
delay_it = 0; /* Don't delay the answer. */
1885
#ifdef MULTI_THREAD_RWL
1886
/* save choice point for trie_unlock instruction */
1887
save_find_locx(ereg);
1888
tbreg = top_of_cpstack;
1892
save_choicepoint(tbreg,ereg,(byte *)&trie_fail_unlock_inst,breg);
1894
cp_prevtop(tbreg) = old_cptop;
1899
return (byte *)ans_root_ptr;
1902
/*----------------------------------------------------------------------*/
1904
byte * trie_get_calls(CTXTdecl)
1909
BTNptr call_trie_root;
1912
#ifdef MULTI_THREAD_RWL
1919
call_term = ptoc_tag(CTXTc 1);
1920
if ((psc_ptr = term_psc(call_term)) != NULL) {
1921
tip_ptr = get_tip(CTXTc psc_ptr);
1922
if (tip_ptr == NULL) {
1923
xsb_abort("get_calls/3 called with non-tabled predicate");
1924
return (byte *)&fail_inst;
1926
call_trie_root = TIF_CallTrie(tip_ptr);
1927
if (call_trie_root == NULL)
1928
return (byte *)&fail_inst;
1930
cptr = (CPtr)cs_val(call_term);
1931
reg_arrayptr = reg_array-1;
1932
num_vars_in_var_regs = -1;
1933
for (i = get_arity(psc_ptr); i>=1; i--) {
1934
#ifdef DEBUG_DELAYVAR
1935
xsb_dbgmsg((LOG_DEBUG,">>>> push one cell"));
1937
pushreg(cell(cptr+i));
1939
#ifdef MULTI_THREAD_RWL
1940
/* save choice point for trie_unlock instruction */
1941
save_find_locx(ereg);
1942
tbreg = top_of_cpstack;
1946
save_choicepoint(tbreg,ereg,(byte *)&trie_fail_unlock_inst,breg);
1948
cp_prevtop(tbreg) = old_cptop;
1954
return (byte *)call_trie_root;
1958
return (byte *)&fail_inst;
1961
/*----------------------------------------------------------------------*/
1964
* This function is changed from get_lastnode_and_retskel(). It is the
1965
* body of *inline* builtin GET_LASTNODE_CS_RETSKEL(LastNode, CallStr,
1966
* RetSkel). [1/9/1999]
1968
* This function is called immediately after using the trie intructions
1969
* to traverse one branch of the call or answer trie. A side-effect of
1970
* executing these instructions is that the leaf node of the branch is
1971
* left in a global variable "Last_Nod_Sav". One reason for writing it
1972
* so is that it is important that the construction of the return
1973
* skeleton is an operation that cannot be interrupted by garbage
1976
* In case we just traversed the Call Trie of a subsumptive predicate,
1977
* and the call we just unified with is subsumed, then the answer
1978
* template (i.e., the return) must be reconstructed based on the
1979
* original call, the argument "callTerm" below, and the subsuming call
1980
* in the table. Otherwise, we return the variables placed in
1981
* "var_regs[]" during the embedded-trie-code walk.
1983
Cell get_lastnode_cs_retskel(CTXTdeclc Cell callTerm) {
1988
arity = global_num_vars + 1;
1989
vector = (Cell *)var_regs;
1990
if ( IsInCallTrie(Last_Nod_Sav) ) {
1991
VariantSF sf = CallTrieLeaf_GetSF(Last_Nod_Sav);
1992
if ( IsProperlySubsumed(sf) ) {
1993
construct_answer_template(CTXTc callTerm, conssf_producer(sf),
1995
arity = (int)var_regs[0];
1996
vector = (Cell *)&var_regs[1];
1999
return ( build_ret_term(CTXTc arity, vector) );
2002
/*----------------------------------------------------------------------*/
2003
/* creates an empty (dummy) answer. */
2004
/*----------------------------------------------------------------------*/
2006
ALNptr empty_return(CTXTdeclc VariantSF subgoal)
2010
/* Used only in one context hence this abuse */
2011
New_ALN(subgoal,i,&dummy_ans_node,NULL);
2015
/*----------------------------------------------------------------------*/
added
removed
emu/tries.c
