154 lines
3.7 KiB
C
154 lines
3.7 KiB
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*/
|
|
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*/
|
|
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*/
|
|
void Yap_ClauseListClose(clause_list_t cl) { /* no need to do nothing */
|
|
}
|
|
|
|
/*destroys the clause list freeing memory*/
|
|
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*/
|
|
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*/
|
|
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 */
|
|
void *Yap_FAILCODE(void) { return (void *)FAILCODE; }
|