/* File: tr_code_xsb_i.h ** Author(s): Prasad Rao, Kostis Sagonas, Baoqiu Cui ** Contact: xsb-contact@cs.sunysb.edu ** ** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998 ** ** 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: tr_code_xsb_i.h,v 1.7 2000/06/22 01:27:51 lfcastro Exp $ ** */ #define opatom Atom(NodePtr) #define opsucc ((byte *)(Child(NodePtr))) #define opfail ((byte *)(Sibl(NodePtr))) #define FIRST_HASH_NODE -1 #define NO_MORE_IN_HASH -2 #define HASH_IS_FREE -3 #define HASH_IS_NOT_FREE -4 /*----------------------------------------------------------------------*/ /* These are used only in instruction "hash_handle" ------------------------------------------------ */ /* * Calculate the bucket number in which Subterm would be located, * should it exist in the trie. */ #define hash_nonvar_subterm(Subterm, pBTHT, BucketNum) { \ \ Cell symbol = 0; /* eliminate compiler warning */ \ \ switch (cell_tag(Subterm)) { \ case XSB_STRING: \ case XSB_INT: \ case XSB_FLOAT: \ symbol = EncodeTrieConstant(Subterm); \ break; \ case XSB_LIST: \ symbol = EncodeTrieList(Subterm); \ break; \ case XSB_STRUCT: \ symbol = EncodeTrieFunctor(Subterm); \ break; \ default: \ fprintf(stderr,"Bad tag :Type %ld ",cell_tag(Subterm)); \ xsb_exit("In instruction hash_handle"); \ break; \ } \ BucketNum = TrieHash(symbol,BTHT_GetHashSeed(pBTHT)); \ } #define find_next_nonempty_bucket(pBTHT, pTable, BucketNum) { \ long TableSize = BTHT_NumBuckets(pBTHT); \ \ while (TRUE) { \ BucketNum++; \ if (BucketNum >= TableSize) { \ BucketNum = NO_MORE_IN_HASH; \ break; \ } \ else if ( IsNonNULL(*(pTable + BucketNum)) ) \ break; \ } \ } /*----------------------------------------------------------------------*/ /* * Decide how to proceed from current node. Used in variable-containing * nodes since it is unclear from the context (embedded instruction) * whether we are at a leaf node. Only variables or constants can be * leaves of the trie, but constants have special instructions when they * appear as leaves. */ #define next_lpcreg { \ if ( IsLeafNode(NodePtr) ) \ proceed_lpcreg \ else \ non_ftag_lpcreg; \ } /* * Use when current node is known to be a leaf of the trie. If we're in * an answer trie, then check for and handle conditional answers. */ #define proceed_lpcreg { \ if( IsInAnswerTrie(NodePtr) && delay_it ) \ handle_conditional_answers; \ global_num_vars = num_vars_in_var_regs; \ num_vars_in_var_regs = -1; \ Last_Nod_Sav = NodePtr; \ lpcreg = cpreg; \ } /* * Use when the current node is known NOT to be a leaf of the trie. * Continue by going to the child of the current node. */ #define non_ftag_lpcreg lpcreg = opsucc /*----------------------------------------------------------------------*/ /* Global variables -- should really be made local ones... */ /*----------------------------------------------------------------------*/ Cell *reg_array; CPtr reg_arrayptr; int reg_array_size = DEFAULT_ARRAYSIZ; #define MAX_TRIE_REGS 500 CPtr var_regs[MAX_TRIE_REGS]; int num_vars_in_var_regs = -1; BTNptr NodePtr, Last_Nod_Sav; /* * Variable delay_it decides whether we should delay an answer after we * have gone though a branch of an answer trie and reached the answer * leaf. If delay_it == 1, then macro handle_conditional_answers() will * be called (in proceed_lpcreg). * * In return_table_code, we need to set delay_it to 1. But in * get_returns/2, we need to set it to 0. */ int delay_it; /*----------------------------------------------------------------------*/ #define restore_regs_and_vars(tbreg,offset) \ undo_bindings(tbreg); \ delayreg = cp_pdreg(tbreg); \ restore_some_wamregs(tbreg, ereg); \ restore_trie_registers(tbreg + offset) /*----------------------------------------------------------------------*/ /* Garbage collection strongly prefers tagged integers in CP stack... */ /* PLEASE PRESERVE THIS IVNARIANT --- Kostis & Bart ! */ /*----------------------------------------------------------------------*/ #define save_trie_registers(tbreg) { \ CPtr temp_arrayptr; \ int reg_count = 0, i; \ \ i = num_vars_in_var_regs; \ while (i >= 0) { \ *(--tbreg) = (Cell)var_regs[i]; \ i--; \ } \ *(--tbreg) = makeint(num_vars_in_var_regs); \ temp_arrayptr = reg_arrayptr; \ while (temp_arrayptr >= reg_array) { \ /* INV: temp_array_ptr + reg_count == reg_arrayptr */ \ *(--tbreg) = *temp_arrayptr; \ reg_count++; \ temp_arrayptr--; \ } \ (*--tbreg) = makeint(reg_count); \ } #define restore_trie_registers(temp) { \ int i; \ CPtr treg = temp; \ \ reg_arrayptr = reg_array - 1; \ i = cell(treg); \ i = int_val(i); \ while (i > 0) { \ reg_arrayptr++; \ *reg_arrayptr = *(++treg); \ i--; \ } \ i = *(++treg); \ num_vars_in_var_regs = int_val(i); \ for (i = 0; i <= num_vars_in_var_regs; i++) { \ var_regs[i] = (CPtr)*(++treg); \ } \ } /*----------------------------------------------------------------------*/ #define unify_with_trie_numcon { \ XSB_Deref(*reg_arrayptr); \ if (isref(*reg_arrayptr)) { \ bind_ref((CPtr)*reg_arrayptr, opatom); \ } \ else if (isattv(*reg_arrayptr)) { \ attv_dbgmsg(">>>> add_interrupt in unify_with_trie_numcon\n"); \ add_interrupt(*reg_arrayptr, opatom); \ } \ else { \ if (*reg_arrayptr != opatom) { \ Fail1; \ XSB_Next_Instr(); \ } \ } \ } #define unify_with_trie_str { \ Psc psc; \ int i, arity; \ \ XSB_Deref(*reg_arrayptr); \ psc = (Psc) cs_val(opatom); \ arity = (int) get_arity(psc); \ will_overflow_reg_array(reg_arrayptr + arity); \ if (isref(*reg_arrayptr)) { \ bind_ref((CPtr) *reg_arrayptr, makecs(hreg)); \ reg_arrayptr--; \ *(hreg++) = (Cell) psc; \ for (i = arity; i >= 1; i--) { \ *(reg_arrayptr + i) = (Cell) hreg; \ new_heap_free(hreg); \ } \ reg_arrayptr += arity; \ } \ else if (isattv(*reg_arrayptr)) { \ attv_dbgmsg(">>>> add_interrupt in unify_with_trie_str\n"); \ add_interrupt(*reg_arrayptr, makecs(hreg)); \ reg_arrayptr--; \ *(hreg++) = (Cell) psc; \ for (i = arity; i >= 1; i--) { \ *(reg_arrayptr + i) = (Cell) hreg; \ new_heap_free(hreg); \ } \ reg_arrayptr += arity; \ } \ else { \ CPtr temp = (CPtr)*reg_arrayptr; \ if ((isconstr(temp)) && (psc == get_str_psc(temp))) { \ reg_arrayptr--; \ temp = (CPtr)cs_val(temp); \ for (i = arity; i >= 1; i--) { \ *(reg_arrayptr+i) = *(temp+arity-i+1); \ } \ reg_arrayptr += arity; \ } \ else { \ Fail1; \ XSB_Next_Instr(); \ } \ } \ } #define unify_with_trie_list { \ XSB_Deref(*reg_arrayptr); \ if (isref(*reg_arrayptr)) { \ bind_ref((CPtr) *reg_arrayptr, (Cell) makelist(hreg)); \ *reg_arrayptr = (Cell)(hreg+1); /* head of list */ \ will_overflow_reg_array(reg_arrayptr + 1); \ *(++reg_arrayptr) = (Cell) hreg; /* tail of list */ \ new_heap_free(hreg); \ new_heap_free(hreg); \ } \ else if (isattv(*reg_arrayptr)) { \ attv_dbgmsg(">>>> add_interrupt in unify_with_trie_list\n"); \ add_interrupt(*reg_arrayptr, makelist(hreg)); \ *reg_arrayptr = (Cell)(hreg+1); /* tail of list */ \ will_overflow_reg_array(reg_arrayptr + 1); \ *(++reg_arrayptr) = (Cell) hreg; /* head of list */ \ new_heap_free(hreg); \ new_heap_free(hreg); \ } \ else { \ CPtr temp = (CPtr)*reg_arrayptr; \ if (islist(temp)) { \ will_overflow_reg_array(reg_arrayptr + 1); \ *reg_arrayptr++ = (Cell)(clref_val(temp)+1); \ *reg_arrayptr = (Cell)(clref_val(temp)); \ } else { \ Fail1; \ XSB_Next_Instr(); \ } \ } \ } /* * In clp(Q,R), most (or all) of the attvs in the call are updated in the * answer. So we have a set of *new* attvs in the answer trie. This set * of new attvs will be copied into the answer trie when the *first* attv * in the call is copied into the answer trie (since most/all of the other * attvs are related to the first one). The later occurrences of the * *other* attvs are encoded as `unify_with_trie_val', but we don't want * to trigger attv interrupts when we update the attvs in the call. */ #define unify_with_trie_val { \ Cell cell2deref; \ XSB_Deref(*reg_arrayptr); \ if (isref(*reg_arrayptr)) { \ cell2deref = (Cell)var_regs[(int)int_val(opatom)]; \ XSB_Deref(cell2deref); \ if (cell2deref != *reg_arrayptr) \ bind_ref((CPtr) *reg_arrayptr, cell2deref); \ } \ else if (isattv(*reg_arrayptr)) { \ cell2deref = (Cell) var_regs[(int)int_val(opatom)]; \ XSB_Deref(cell2deref); \ if (*reg_arrayptr != cell2deref) { \ /* Do not trigger attv interrupt! */ \ bind_ref(clref_val(*reg_arrayptr), cell2deref); \ } \ else { \ attv_dbgmsg(">>>> keep old attr in unify_with_trie_val\n"); \ } \ } \ else { \ op1 = (Cell)*reg_arrayptr; \ op2 = (Cell) var_regs[(int)int_val(opatom)]; \ if (unify(op1,op2) == FALSE) { \ Fail1; \ XSB_Next_Instr(); \ } \ } \ reg_arrayptr--; \ } #define unify_with_trie_attv { \ XSB_Deref(*reg_arrayptr); \ num_vars_in_var_regs = (int)int_val(opatom) &0xffff; \ if (isref(*reg_arrayptr)) { \ bind_ref((CPtr) *reg_arrayptr, makeattv(hreg)); \ } \ else if (isattv(*reg_arrayptr)) { \ bind_ref(clref_val(*reg_arrayptr), makeattv(hreg)); \ } \ else { \ attv_dbgmsg(">>>> add_interrupt in unify_with_trie_attv\n"); \ add_interrupt(makeattv(hreg), *reg_arrayptr); \ } \ var_regs[num_vars_in_var_regs] = (CPtr) makeattv(hreg); \ new_heap_free(hreg); \ *reg_arrayptr = (Cell) hreg; \ new_heap_free(hreg); \ } /*----------------------------------------------------------------------*/