yap-6.3/C/clause_list.c

#include "Yap.h"
#include "clause.h"
#include "tracer.h"
#ifdef YAPOR
#include "or.macros.h"
#endif	/* YAPOR */
#include "clause_list.h"

/* need to fix overflow handling */

static void
mk_blob(int sz USES_REGS)
{
  MP_INT *dst;
 
  HR[0] = (CELL)FunctorBigInt;
  HR[1] = CLAUSE_LIST;
  dst = (MP_INT *)(HR+2);
  dst->_mp_size = 0L;
  dst->_mp_alloc = sz;
  HR += (1+sizeof(MP_INT)/sizeof(CELL));
  HR[sz] = EndSpecials;
  HR += sz+1;
}

static CELL *
extend_blob(CELL *start, int sz USES_REGS)
{
  UInt osize;
  MP_INT *dst;
  
  if (HR + sz > ASP)
    return NULL;
  dst = (MP_INT *)(start+2);
  osize = dst->_mp_alloc;
  start += (1+sizeof(MP_INT)/sizeof(CELL));
  start[sz+osize] = EndSpecials;
  dst->_mp_alloc += sz;
  HR += sz;
  return start+osize;
}

/*init of ClasuseList*/
X_API clause_list_t
Yap_ClauseListInit(clause_list_t in)
{
  CACHE_REGS
  in->n = 0;
  in->start = HR;
  mk_blob(0 PASS_REGS);
  in->end = HR;
  return in;
}

/*add clause to ClauseList
 returns FALSE on error*/
X_API int
Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
{
  CACHE_REGS
  PredEntry *ap = (PredEntry *)pred;

  /*  fprintf(stderr,"cl=%p\n",clause); */
  if (cl->end != HR)
    return FALSE;
  if (cl->n == 0) {
    void **ptr;
    if (!(ptr = (void **)extend_blob(cl->start,1 PASS_REGS))) return FALSE;
    ptr[0] = clause;
  } else if (cl->n == 1)  {
    yamop **ptr;
    yamop *code_p, *fclause;
    
    if (!(ptr = (yamop **)extend_blob(cl->start,2*(CELL)NEXTOP((yamop *)NULL,Otapl)/sizeof(CELL)-1 PASS_REGS))) return FALSE;
    fclause = ptr[-1];
    code_p = (yamop *)(ptr-1);
    code_p->opc = Yap_opcode(_try_clause);
    code_p->y_u.Otapl.d = fclause;
    code_p->y_u.Otapl.s = ap->ArityOfPE;
    code_p->y_u.Otapl.p = ap;
#ifdef TABLING
    code_p->y_u.Otapl.te = ap->TableOfPred;
#endif
#ifdef YAPOR
    INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
    code_p = NEXTOP(code_p,Otapl);
    code_p->opc = Yap_opcode(_trust);
    code_p->y_u.Otapl.d = clause;
    code_p->y_u.Otapl.s = ap->ArityOfPE;
    code_p->y_u.Otapl.p = ap;
#ifdef TABLING
    code_p->y_u.Otapl.te = ap->TableOfPred;
#endif
#ifdef YAPOR
    INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
  } else {
    yamop *code_p;

    if (!(code_p = (yamop *)extend_blob(cl->start,((CELL)NEXTOP((yamop *)NULL,Otapl))/sizeof(CELL) PASS_REGS))) return FALSE;
    code_p->opc = Yap_opcode(_trust);
    code_p->y_u.Otapl.d = clause;
    code_p->y_u.Otapl.s = ap->ArityOfPE;
    code_p->y_u.Otapl.p = ap;
#ifdef TABLING
    code_p->y_u.Otapl.te = ap->TableOfPred;
#endif
#ifdef YAPOR
    INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
    code_p = PREVOP(code_p,Otapl);
    code_p->opc = Yap_opcode(_retry);
  }
  cl->end = HR;
  cl->n++;
  return TRUE;
}

/*closes the clause list*/
X_API void
Yap_ClauseListClose(clause_list_t cl)
{
  /* no need to do nothing */
}

/*destroys the clause list freeing memory*/
X_API int
Yap_ClauseListDestroy(clause_list_t cl)
{
  CACHE_REGS
  if (cl->end != HR)
    return FALSE;
  HR = cl->start;
  return TRUE;
}

/*destroys clause list and returns only first clause*/
X_API void *
Yap_ClauseListToClause(clause_list_t cl)
{
  CACHE_REGS
  void **ptr;
  if (cl->end != HR)
    return NULL;
  if (cl->n != 1)
    return NULL;
  if (!(ptr = (void **)extend_blob(cl->start,0 PASS_REGS))) return NULL;
  return ptr[-1];
}

/*return pointer to start of try-retry-trust sequence*/
X_API void *
Yap_ClauseListCode(clause_list_t cl)
{
  CELL *ptr;
  ptr = (CELL *)cl->start;
  ptr += (1+sizeof(MP_INT)/sizeof(CELL));
  return (void *)ptr;
}

/* where to fail */
X_API void *
Yap_FAILCODE(void)
{
  return (void *)FAILCODE;
}