include support for dynamically created clause lists.
This commit is contained in:
Vitor Santos Costa
parent
76971fa724
commit
1191b039d5
158
C/clause_list.c
Normal file
158
C/clause_list.c
Normal file
@ -0,0 +1,158 @@
|
||||
#include "Yap.h"
|
||||
#include "clause.h"
|
||||
#include "clause_list.h"
|
||||
|
||||
static void
|
||||
mk_blob(int sz)
|
||||
{
|
||||
MP_INT *dst;
|
||||
|
||||
H[0] = (CELL)FunctorBigInt;
|
||||
H[1] = CLAUSE_LIST;
|
||||
dst = (MP_INT *)(H+2);
|
||||
dst->_mp_size = 0L;
|
||||
dst->_mp_alloc = sz;
|
||||
H += (1+sizeof(MP_INT)/sizeof(CELL));
|
||||
H[sz] = EndSpecials;
|
||||
H += sz+1;
|
||||
}
|
||||
|
||||
static CELL *
|
||||
extend_blob(CELL *start, int sz)
|
||||
{
|
||||
UInt osize;
|
||||
MP_INT *dst;
|
||||
|
||||
if (H + 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;
|
||||
H += sz;
|
||||
return start+osize;
|
||||
}
|
||||
|
||||
/*init of ClasuseList*/
|
||||
X_API clause_list_t
|
||||
Yap_ClauseListInit(clause_list_t in)
|
||||
{
|
||||
in->n = 0;
|
||||
in->start = H;
|
||||
mk_blob(0);
|
||||
in->end = H;
|
||||
return in;
|
||||
}
|
||||
|
||||
/*add clause to ClauseList
|
||||
returns FALSE on error*/
|
||||
X_API int
|
||||
Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred)
|
||||
{
|
||||
PredEntry *ap = (PredEntry *)pred;
|
||||
|
||||
if (cl->end != H)
|
||||
return FALSE;
|
||||
if (cl->n == 0) {
|
||||
void **ptr;
|
||||
if (!(ptr = (void **)extend_blob(cl->start,1))) 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))) return FALSE;
|
||||
fclause = ptr[-1];
|
||||
code_p = (yamop *)(ptr-1);
|
||||
code_p->opc = Yap_opcode(_try_clause);
|
||||
code_p->u.Otapl.d = fclause;
|
||||
code_p->u.Otapl.s = ap->ArityOfPE;
|
||||
code_p->u.Otapl.p = ap;
|
||||
#ifdef TABLING
|
||||
code_p->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->u.Otapl.d = clause;
|
||||
code_p->u.Otapl.s = 0;
|
||||
code_p->u.Otapl.p = ap;
|
||||
#ifdef TABLING
|
||||
code_p->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)))) return FALSE;
|
||||
code_p->opc = Yap_opcode(_trust);
|
||||
code_p->u.Otapl.d = clause;
|
||||
code_p->u.Otapl.s = ap->ArityOfPE;
|
||||
code_p->u.Otapl.p = ap;
|
||||
#ifdef TABLING
|
||||
code_p->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 = H;
|
||||
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)
|
||||
{
|
||||
if (cl->end != H)
|
||||
return FALSE;
|
||||
H = cl->start;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
/*destroys clause list and returns only first clause*/
|
||||
X_API void *
|
||||
Yap_ClauseListToClause(clause_list_t cl)
|
||||
{
|
||||
void **ptr;
|
||||
if (cl->end != H)
|
||||
return NULL;
|
||||
if (cl->n != 1)
|
||||
return NULL;
|
||||
if (!(ptr = (void **)extend_blob(cl->start,0))) 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;
|
||||
}
|
||||
|
||||
|
||||
@ -2162,6 +2162,10 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
case _count_trust_me:
|
||||
case _retry:
|
||||
case _trust:
|
||||
if (IN_BETWEEN(H0,(CELL *)(gc_B->cp_ap),H)) {
|
||||
fprintf(stderr,"OOPS: gc not supported in this case!!!\n");
|
||||
exit(1);
|
||||
}
|
||||
nargs = rtp->u.Otapl.s;
|
||||
break;
|
||||
default:
|
||||
|
||||
@ -63,7 +63,8 @@ typedef enum
|
||||
BIG_FLOAT = 0x04,
|
||||
EMPTY_ARENA = 0x10,
|
||||
ARRAY_INT = 0x21,
|
||||
ARRAY_FLOAT = 0x22
|
||||
ARRAY_FLOAT = 0x22,
|
||||
CLAUSE_LIST = 0x40
|
||||
}
|
||||
big_blob_type;
|
||||
|
||||
|
||||
14
Makefile.in
14
Makefile.in
@ -97,7 +97,13 @@ VERSION=Yap-5.1.4
|
||||
MYDDAS_VERSION=MYDDAS-0.9.1
|
||||
#
|
||||
|
||||
INTERFACE_HEADERS = $(srcdir)/include/c_interface.h $(srcdir)/include/yap_structs.h $(srcdir)/include/YapInterface.h $(srcdir)/include/SWI-Prolog.h $(srcdir)/include/SWI-Stream.h
|
||||
INTERFACE_HEADERS = \
|
||||
$(srcdir)/include/c_interface.h \
|
||||
$(srcdir)/include/clause_list.h \
|
||||
$(srcdir)/include/yap_structs.h \
|
||||
$(srcdir)/include/YapInterface.h \
|
||||
$(srcdir)/include/SWI-Prolog.h \
|
||||
$(srcdir)/include/SWI-Stream.h
|
||||
|
||||
HEADERS = \
|
||||
$(srcdir)/H/TermExt.h $(srcdir)/H/Atoms.h \
|
||||
@ -146,6 +152,7 @@ C_SOURCES= \
|
||||
$(srcdir)/C/attvar.c $(srcdir)/C/bb.c \
|
||||
$(srcdir)/C/bignum.c \
|
||||
$(srcdir)/C/c_interface.c $(srcdir)/C/cdmgr.c $(srcdir)/C/cmppreds.c \
|
||||
$(srcdir)/C/clause_list.c \
|
||||
$(srcdir)/C/compiler.c $(srcdir)/C/computils.c \
|
||||
$(srcdir)/C/corout.c $(srcdir)/C/dbase.c $(srcdir)/C/dlmalloc.c \
|
||||
$(srcdir)/C/errors.c \
|
||||
@ -241,7 +248,7 @@ ENGINE_OBJECTS = \
|
||||
C_INTERFACE_OBJECTS = \
|
||||
load_foreign.o load_dl.o load_dld.o load_dyld.o \
|
||||
load_none.o load_aout.o load_aix.o load_dll.o load_shl.o \
|
||||
c_interface.o
|
||||
c_interface.o clause_list.o
|
||||
|
||||
OR_OBJECTS = \
|
||||
opt.memory.o opt.misc.o opt.init.o opt.preds.o \
|
||||
@ -313,6 +320,9 @@ c_interface.o: $(srcdir)/C/c_interface.c $(srcdir)/include/c_interface.h
|
||||
cdmgr.o: $(srcdir)/C/cdmgr.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/C/cdmgr.c -o $@
|
||||
|
||||
clause_list.o: $(srcdir)/C/clause_list.c $(srcdir)/include/clause_list.h
|
||||
$(CC) $(C_INTERF_FLAGS) -c $(srcdir)/C/clause_list.c -o clause_list.o
|
||||
|
||||
cmppreds.o: $(srcdir)/C/cmppreds.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/C/cmppreds.c -o $@
|
||||
|
||||
|
||||
27
include/clause_list.h
Normal file
27
include/clause_list.h
Normal file
@ -0,0 +1,27 @@
|
||||
|
||||
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
|
||||
#define X_API __declspec(dllexport)
|
||||
#else
|
||||
#define X_API
|
||||
#endif
|
||||
|
||||
|
||||
struct ClauseList
|
||||
{
|
||||
int n; /*counter*/
|
||||
void *start;
|
||||
void *end;
|
||||
};
|
||||
typedef struct ClauseList *clause_list_t;
|
||||
|
||||
X_API clause_list_t Yap_ClauseListInit(clause_list_t in);
|
||||
|
||||
X_API int Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred);
|
||||
X_API void Yap_ClauseListClose(clause_list_t cl);
|
||||
X_API int Yap_ClauseListDestroy(clause_list_t cl);
|
||||
X_API void *Yap_ClauseListToClause(clause_list_t cl);
|
||||
X_API void *Yap_ClauseListCode(clause_list_t cl);
|
||||
X_API void *Yap_FAILCODE(void);
|
||||
|
||||
#define ClauseListCount(cl) cl->n
|
||||
#define ClauseList(cl) cl->start
|
||||
Reference in New Issue
Block a user