This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/clause_list.c

154 lines
3.7 KiB
C
Raw Normal View History

#include "Yap.h"
#include "clause.h"
#include "tracer.h"
#ifdef YAPOR
#include "or.macros.h"
2016-01-31 10:14:28 +00:00
#endif /* YAPOR */
#include "clause_list.h"
2009-02-16 12:53:29 +00:00
/* need to fix overflow handling */
2016-01-31 10:14:28 +00:00
static void mk_blob(int sz USES_REGS) {
MP_INT *dst;
2016-01-31 10:14:28 +00:00
2014-01-19 21:15:05 +00:00
HR[0] = (CELL)FunctorBigInt;
HR[1] = CLAUSE_LIST;
2016-01-31 10:14:28 +00:00
dst = (MP_INT *)(HR + 2);
dst->_mp_size = 0L;
dst->_mp_alloc = sz;
2016-01-31 10:14:28 +00:00
HR += (1 + sizeof(MP_INT) / sizeof(CELL));
2014-01-19 21:15:05 +00:00
HR[sz] = EndSpecials;
2016-01-31 10:14:28 +00:00
HR += sz + 1;
}
2016-01-31 10:14:28 +00:00
static CELL *extend_blob(CELL *start, int sz USES_REGS) {
UInt osize;
MP_INT *dst;
2016-01-31 10:14:28 +00:00
2014-01-19 21:15:05 +00:00
if (HR + sz > ASP)
return NULL;
2016-01-31 10:14:28 +00:00
dst = (MP_INT *)(start + 2);
osize = dst->_mp_alloc;
2016-01-31 10:14:28 +00:00
start += (1 + sizeof(MP_INT) / sizeof(CELL));
start[sz + osize] = EndSpecials;
dst->_mp_alloc += sz;
2014-01-19 21:15:05 +00:00
HR += sz;
2016-01-31 10:14:28 +00:00
return start + osize;
}
/*init of ClasuseList*/
2016-01-31 10:14:28 +00:00
clause_list_t Yap_ClauseListInit(clause_list_t in) {
CACHE_REGS in->n = 0;
2014-01-19 21:15:05 +00:00
in->start = HR;
mk_blob(0 PASS_REGS);
2014-01-19 21:15:05 +00:00
in->end = HR;
return in;
}
/*add clause to ClauseList
returns FALSE on error*/
2016-01-31 10:14:28 +00:00
int Yap_ClauseListExtend(clause_list_t cl, void *clause, void *pred) {
CACHE_REGS
PredEntry *ap = (PredEntry *)pred;
2009-02-20 11:42:48 +00:00
/* fprintf(stderr,"cl=%p\n",clause); */
2014-01-19 21:15:05 +00:00
if (cl->end != HR)
return FALSE;
if (cl->n == 0) {
void **ptr;
2016-01-31 10:14:28 +00:00
if (!(ptr = (void **)extend_blob(cl->start, 1 PASS_REGS)))
return FALSE;
ptr[0] = clause;
2016-01-31 10:14:28 +00:00
} else if (cl->n == 1) {
yamop **ptr;
yamop *code_p, *fclause;
2016-01-31 10:14:28 +00:00
if (!(ptr = (yamop **)extend_blob(
cl->start, 2 * (CELL)NEXTOP((yamop *)NULL, Otapl) / sizeof(CELL) -
1 PASS_REGS)))
return FALSE;
fclause = ptr[-1];
2016-01-31 10:14:28 +00:00
code_p = (yamop *)(ptr - 1);
code_p->opc = Yap_opcode(_try_clause);
2014-05-30 01:06:09 +01:00
code_p->y_u.Otapl.d = fclause;
code_p->y_u.Otapl.s = ap->ArityOfPE;
code_p->y_u.Otapl.p = ap;
#ifdef TABLING
2014-05-30 01:06:09 +01:00
code_p->y_u.Otapl.te = ap->TableOfPred;
#endif
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
2016-01-31 10:14:28 +00:00
code_p = NEXTOP(code_p, Otapl);
code_p->opc = Yap_opcode(_trust);
2014-05-30 01:06:09 +01:00
code_p->y_u.Otapl.d = clause;
code_p->y_u.Otapl.s = ap->ArityOfPE;
code_p->y_u.Otapl.p = ap;
#ifdef TABLING
2014-05-30 01:06:09 +01:00
code_p->y_u.Otapl.te = ap->TableOfPred;
#endif
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
} else {
yamop *code_p;
2016-01-31 10:14:28 +00:00
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);
2014-05-30 01:06:09 +01:00
code_p->y_u.Otapl.d = clause;
code_p->y_u.Otapl.s = ap->ArityOfPE;
code_p->y_u.Otapl.p = ap;
#ifdef TABLING
2014-05-30 01:06:09 +01:00
code_p->y_u.Otapl.te = ap->TableOfPred;
#endif
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, 0);
#endif /* YAPOR */
2016-01-31 10:14:28 +00:00
code_p = PREVOP(code_p, Otapl);
code_p->opc = Yap_opcode(_retry);
}
2014-01-19 21:15:05 +00:00
cl->end = HR;
cl->n++;
return TRUE;
}
/*closes the clause list*/
2016-01-31 10:14:28 +00:00
void Yap_ClauseListClose(clause_list_t cl) { /* no need to do nothing */
}
/*destroys the clause list freeing memory*/
2016-01-31 10:14:28 +00:00
int Yap_ClauseListDestroy(clause_list_t cl) {
CACHE_REGS
2014-01-19 21:15:05 +00:00
if (cl->end != HR)
return FALSE;
2014-01-19 21:15:05 +00:00
HR = cl->start;
return TRUE;
}
/*destroys clause list and returns only first clause*/
2016-01-31 10:14:28 +00:00
void *Yap_ClauseListToClause(clause_list_t cl) {
CACHE_REGS
void **ptr;
2014-01-19 21:15:05 +00:00
if (cl->end != HR)
return NULL;
if (cl->n != 1)
return NULL;
2016-01-31 10:14:28 +00:00
if (!(ptr = (void **)extend_blob(cl->start, 0 PASS_REGS)))
return NULL;
return ptr[-1];
}
/*return pointer to start of try-retry-trust sequence*/
2016-01-31 10:14:28 +00:00
void *Yap_ClauseListCode(clause_list_t cl) {
CELL *ptr;
ptr = (CELL *)cl->start;
2016-01-31 10:14:28 +00:00
ptr += (1 + sizeof(MP_INT) / sizeof(CELL));
return (void *)ptr;
}
/* where to fail */
2016-01-31 10:14:28 +00:00
void *Yap_FAILCODE(void) { return (void *)FAILCODE; }