include support for dynamically created clause lists.

C/clause_list.c

@@ -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;
+}
+
+

C/heapgc.c

@@ -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:

H/TermExt.h

@@ -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;
 

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 $@
 

include/clause_list.h

@@ -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