/* 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);							\
}

/*----------------------------------------------------------------------*/
