Atom Translations and CUDA stub

C/adtdefs.c

@@ -1176,6 +1176,30 @@ Yap_PutValue(Atom a, Term v)
   WRITE_UNLOCK(p->VRWLock);
 }
 
+void
+Yap_PutAtomTranslation(Atom a, Int i)
+{
+  AtomEntry *ae = RepAtom(a);
+  Prop p0;
+  TranslationEntry *p;
+
+  WRITE_LOCK(ae->ARWLock);
+  p0 = GetAPropHavingLock(ae, TranslationProperty);
+  if (p0 == NIL) {
+    p = (TranslationEntry *) Yap_AllocAtomSpace(sizeof(TranslationEntry));
+    if (p == NULL) {
+      WRITE_UNLOCK(ae->ARWLock);
+      return;
+    }
+    p->KindOfPE = TranslationProperty;
+    p->Translation = i;
+    AddPropToAtom(RepAtom(a), (PropEntry *)p);
+  }
+  /* take care that the lock for the property will be inited even
+     if someone else searches for the property */
+  WRITE_UNLOCK(ae->ARWLock);
+}
+
 Term
 Yap_StringToList(char *s)
 {

C/c_interface.c

@@ -567,6 +567,8 @@ X_API size_t   YAP_ExportTerm(Term, char *, size_t);
 X_API size_t   YAP_SizeOfExportedTerm(char *);
 X_API Term     YAP_ImportTerm(char *);
 X_API int      YAP_RequiresExtraStack(size_t);
+X_API Int      YAP_AtomToInt(Atom At);
+X_API Atom     YAP_IntToAtom(Int i);
 
 static UInt
 current_arity(void)
@@ -4140,3 +4142,21 @@ YAP_RequiresExtraStack(size_t sz) {
   RECOVER_H();
   return TRUE;
 }
+
+X_API Int
+YAP_AtomToInt(Atom At)
+{
+  TranslationEntry *te = Yap_GetTranslationProp(At);
+  if (te != NIL) return te->Translation;
+  SWI_Atoms[AtomTranslations] = At;
+  Yap_PutAtomTranslation(At, AtomTranslations);
+  AtomTranslations++;
+  return AtomTranslations-1;
+}
+
+X_API Atom
+YAP_IntToAtom(Int i)
+{
+  return SWI_Atoms[i];
+}
+

H/Yatom.h

@@ -191,6 +191,8 @@ IsFunctorProperty (int flags)
 	bb 00	functor entry 
 	ff df	sparse functor
 	ff ex	arithmetic property
+	ff f4   translation
+	ff f5   blob
 	ff f6   hold
 	ff f7   array
 	ff f8   wide atom
@@ -1175,16 +1177,90 @@ AbsHoldProp (HoldEntry * p)
 
 
 #endif
+
 #define	HoldProperty  0xfff6
 
+/*		translation property entry structure				*/
+typedef struct translation_entry
+{
+  Prop NextOfPE;		/* used to chain properties             */
+  PropFlags KindOfPE;		/* kind of property                     */
+  Int  Translation;		/* used to hash the atom as an integer; */
+}  TranslationEntry;
+
+#if USE_OFFSETS_IN_PROPS
+
+INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp (Prop p);
+
+INLINE_ONLY inline EXTERN TranslationEntry *
+RepTranslationProp (Prop p)
+{
+  return (TranslationEntry *) (AtomBase + Unsigned (p));
+}
+
+
+
+INLINE_ONLY inline EXTERN Prop AbsTranslationProp (TranslationEntry * p);
+
+INLINE_ONLY inline EXTERN Prop
+AbsTranslationProp (TranslationEntry * p)
+{
+  return (Prop) (Addr (p) - AtomBase);
+}
+
+
+#else
+
+INLINE_ONLY inline EXTERN TranslationEntry *RepTranslationProp (Prop p);
+
+INLINE_ONLY inline EXTERN TranslationEntry *
+RepTranslationProp (Prop p)
+{
+  return (TranslationEntry *) (p);
+}
+
+
+
+INLINE_ONLY inline EXTERN Prop AbsTranslationProp (TranslationEntry * p);
+
+INLINE_ONLY inline EXTERN Prop
+AbsTranslationProp (TranslationEntry * p)
+{
+  return (Prop) (p);
+}
+
+
+#endif
+#define	TranslationProperty  0xfff4
+
+void Yap_PutAtomTranslation(Atom a, Int i);
+
+/* get translation prop for atom;               */
+static inline TranslationEntry *
+Yap_GetTranslationProp(Atom at)
+{
+  Prop p0;
+  AtomEntry *ae = RepAtom(at);
+  TranslationEntry *p;
+
+  READ_LOCK(ae->ARWLock);
+  p = RepTranslationProp(p0 = ae->PropsOfAE);
+  while (p0 && p->KindOfPE != TranslationProperty)
+    p = RepTranslationProp(p0 = p->NextOfPE);
+  READ_UNLOCK(ae->ARWLock);
+  if (p0 == NIL) return NULL;
+  return p;
+}
+
+
 /* only unary and binary expressions are acceptable */
 
-INLINE_ONLY inline EXTERN PropFlags IsHoldProperty (int);
+INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty (int);
 
 INLINE_ONLY inline EXTERN PropFlags
-IsHoldProperty (int flags)
+IsTranslationProperty (int flags)
 {
-  return (PropFlags) ((flags == HoldProperty));
+  return (PropFlags) ((flags == TranslationProperty));
 }
 
 

H/dhstruct.h

@@ -298,6 +298,9 @@
 #define SWI_Atoms Yap_heap_regs->swi_atoms
 #define SWI_Functors Yap_heap_regs->swi_functors
 #define SWI_ReverseHash Yap_heap_regs->swi_reverse_hash
+
+#define AtomTranslations Yap_heap_regs->atom_translations
+#define MaxAtomTranslations Yap_heap_regs->max_atom_translations
 #define EmptyWakeups Yap_heap_regs->empty_wakeups
 #define MaxEmptyWakeups Yap_heap_regs->max_empty_wakeups
 

H/hstruct.h

@@ -295,9 +295,12 @@
 
   struct record_list  *yap_records;
 
-  Atom  swi_atoms[N_SWI_ATOMS];
+  Atom  swi_atoms[2*N_SWI_ATOMS];
   Functor  swi_functors[N_SWI_FUNCTORS];
   struct swi_reverse_hash  swi_reverse_hash[N_SWI_HASH];
+
+  Int  atom_translations;
+  Int  max_atom_translations;
   Atom  empty_wakeups[MAX_EMPTY_WAKEUPS];
   int  max_empty_wakeups;
 

H/ihstruct.h

@@ -298,6 +298,9 @@
   InitSWIAtoms();
 
 
+
+
+  MaxAtomTranslations = 2*N_SWI_ATOMS;
   InitEmptyWakeups();
   MaxEmptyWakeups = 0;
 

H/rheap.h

@@ -727,7 +727,7 @@ static void
 RestoreSWIAtoms__( USES_REGS1 )
 {
   int i, j;
-  for (i=0; i < N_SWI_ATOMS; i++) {
+  for (i=0; i < AtomTranslations; i++) {
     SWI_Atoms[i] = AtomAdjust(SWI_Atoms[i]);
   }
   for (j=0; j < N_SWI_FUNCTORS; j++) {
@@ -1474,6 +1474,13 @@ RestoreEntries(PropEntry *pp, int int_key USES_REGS)
 	  PropAdjust(he->NextOfPE);
       }
       break;
+    case TranslationProperty:
+      {
+	TranslationEntry *he = (TranslationEntry *)pp;
+	he->NextOfPE =
+	  PropAdjust(he->NextOfPE);
+      }
+      break;
     case ArrayProperty:
       {
 	ArrayEntry *ae = (ArrayEntry *)pp;

H/rhstruct.h

@@ -298,6 +298,9 @@
   RestoreSWIAtoms();
 
 
+
+
+
   RestoreEmptyWakeups();
 
 

configure

@@ -703,6 +703,8 @@ ENABLE_HTTP
 ENABLE_CLPQR
 ENABLE_CLIB
 ENABLE_CHR
+CUDA_LDFLAGS
+CUDA_CPPFLAGS
 NO_BUILTIN_REGEXP
 YAP_EXTRAS
 SONAMEFLAG
@@ -5000,12 +5002,33 @@ if test "${with_junit+set}" = set; then :
 fi
 
 
-$as_echo "#define MinHeapSpace (1000*SIZEOF_INT_P)" >>confdefs.h
+if test "$orparallelism" = no
+then
+  $as_echo "#define MinHeapSpace (1000*SIZEOF_INT_P)" >>confdefs.h
 
-$as_echo "#define MinStackSpace (300*SIZEOF_INT_P)" >>confdefs.h
+  $as_echo "#define MinStackSpace (300*SIZEOF_INT_P)" >>confdefs.h
 
-$as_echo "#define MinTrailSpace ( 48*SIZEOF_INT_P)" >>confdefs.h
+  $as_echo "#define MinTrailSpace ( 48*SIZEOF_INT_P)" >>confdefs.h
 
+  $as_echo "#define MAX_WORKERS 1" >>confdefs.h
+
+else
+  $as_echo "#define MinHeapSpace (2000*SIZEOF_INT_P)" >>confdefs.h
+
+  $as_echo "#define MinStackSpace (600*SIZEOF_INT_P)" >>confdefs.h
+
+  $as_echo "#define MinTrailSpace (100*SIZEOF_INT_P)" >>confdefs.h
+
+  cat >>confdefs.h <<_ACEOF
+#define MAX_WORKERS $yap_cv_max_workers
+_ACEOF
+
+  if test "$orparallelism" = copy -o "$orparallelism" = yes
+  then
+    use_malloc="no"
+  fi
+  tabling="no"
+fi
 
 cat >>confdefs.h <<_ACEOF
 #define DefHeapSpace $yap_cv_heap_space
@@ -5024,22 +5047,6 @@ _ACEOF
 
 
 
-if test "$orparallelism" = no
-then
-  $as_echo "#define MAX_WORKERS 1" >>confdefs.h
-
-else
-  cat >>confdefs.h <<_ACEOF
-#define MAX_WORKERS $yap_cv_max_workers
-_ACEOF
-
-  if test "$orparallelism" = copy -o "$orparallelism" = yes
-  then
-    use_malloc="no"
-  fi
-  tabling="no"
-fi
-
 if test "$threads" = no
 then
   $as_echo "#define MAX_THREADS 1" >>confdefs.h
@@ -5144,6 +5151,11 @@ else
   ENABLE_CUDD=""
 fi
 
+CUDA_LDFLAGS=""
+CUDA_CPPFLAGS=""
+
+
+
 if test "$use_condor" = yes
 then
   static_compilation="yes"
@@ -9806,6 +9818,8 @@ CMDEXT=sh
 
 
 
+
+
 
 
 
@@ -11335,6 +11349,7 @@ mkdir -p  packages/clpqr
 mkdir -p  packages/cplint
 mkdir -p  packages/cplint/approx
 mkdir -p  packages/cplint/approx/simplecuddLPADs
+mkdir -p  packages/cuda
 mkdir -p  packages/http
 mkdir -p  packages/jpl
 mkdir -p  packages/jpl/src
@@ -11547,6 +11562,9 @@ fi
 ac_config_files="$ac_config_files packages/yap-lbfgs/Makefile"
 
 
+ac_config_files="$ac_config_files packages/cuda/Makefile"
+
+
 cat >confcache <<\_ACEOF
 # This file is a shell script that caches the results of configure
 # tests run on this system so they can be shared between configure
@@ -12295,6 +12313,7 @@ do
     "packages/prism/src/c/Makefile") CONFIG_FILES="$CONFIG_FILES packages/prism/src/c/Makefile" ;;
     "packages/prism/src/prolog/Makefile") CONFIG_FILES="$CONFIG_FILES packages/prism/src/prolog/Makefile" ;;
     "packages/yap-lbfgs/Makefile") CONFIG_FILES="$CONFIG_FILES packages/yap-lbfgs/Makefile" ;;
+    "packages/cuda/Makefile") CONFIG_FILES="$CONFIG_FILES packages/cuda/Makefile" ;;
 
   *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
   esac

configure.in

@@ -467,9 +467,23 @@ AC_ARG_WITH(junit, [  --with-junit=PATH	  Specify location of the junit JAR file
 			;;
 	     esac])
 
-AC_DEFINE(MinHeapSpace, (1000*SIZEOF_INT_P))
-AC_DEFINE(MinStackSpace,(300*SIZEOF_INT_P)) 
-AC_DEFINE(MinTrailSpace,( 48*SIZEOF_INT_P))
+if test "$orparallelism" = no
+then
+  AC_DEFINE(MinHeapSpace, (1000*SIZEOF_INT_P))
+  AC_DEFINE(MinStackSpace,(300*SIZEOF_INT_P)) 
+  AC_DEFINE(MinTrailSpace,( 48*SIZEOF_INT_P))
+  AC_DEFINE(MAX_WORKERS,1)
+else
+  AC_DEFINE(MinHeapSpace, (2000*SIZEOF_INT_P))
+  AC_DEFINE(MinStackSpace,(600*SIZEOF_INT_P)) 
+  AC_DEFINE(MinTrailSpace,(100*SIZEOF_INT_P))
+  AC_DEFINE_UNQUOTED(MAX_WORKERS,$yap_cv_max_workers)
+  if test "$orparallelism" = copy -o "$orparallelism" = yes
+  then
+    use_malloc="no"
+  fi
+  tabling="no"
+fi
 
 AC_DEFINE_UNQUOTED(DefHeapSpace,$yap_cv_heap_space)
 AC_DEFINE_UNQUOTED(DefStackSpace,$yap_cv_stack_space)
@@ -479,18 +493,6 @@ AC_SUBST(DefHeapSpace)
 AC_SUBST(DefStackSpace)
 AC_SUBST(DefTrailSpace)
 
-if test "$orparallelism" = no
-then
-  AC_DEFINE(MAX_WORKERS,1)
-else
-  AC_DEFINE_UNQUOTED(MAX_WORKERS,$yap_cv_max_workers)
-  if test "$orparallelism" = copy -o "$orparallelism" = yes
-  then
-    use_malloc="no"
-  fi
-  tabling="no"
-fi
-
 if test "$threads" = no
 then
   AC_DEFINE(MAX_THREADS,1)
@@ -565,6 +567,11 @@ else
   ENABLE_CUDD=""
 fi
 
+CUDA_LDFLAGS=""
+CUDA_CPPFLAGS=""
+
+
+
 dnl condor universe does not like dynamic linking on Linux, DEC, and HP-UX platforms.
 if test "$use_condor" = yes 
 then
@@ -1837,6 +1844,8 @@ AC_SUBST(INSTALL_INFO)
 dnl let YAP_EXTRAS fall through configure, from the env into Makefile
 AC_SUBST(YAP_EXTRAS)
 AC_SUBST(NO_BUILTIN_REGEXP)
+AC_SUBST(CUDA_CPPFLAGS)
+AC_SUBST(CUDA_LDFLAGS)
 AC_SUBST(ENABLE_CHR)
 AC_SUBST(ENABLE_CLIB)
 AC_SUBST(ENABLE_CLPQR)
@@ -2500,6 +2509,7 @@ mkdir -p  packages/clpqr
 mkdir -p  packages/cplint
 mkdir -p  packages/cplint/approx
 mkdir -p  packages/cplint/approx/simplecuddLPADs
+mkdir -p  packages/cuda
 mkdir -p  packages/http
 mkdir -p  packages/jpl
 mkdir -p  packages/jpl/src
@@ -2659,5 +2669,7 @@ fi
 
 AC_CONFIG_FILES([packages/yap-lbfgs/Makefile])
 
+AC_CONFIG_FILES([packages/cuda/Makefile])
+
 AC_OUTPUT()
 

library/dialect/swi/fli/swi.c

@@ -100,10 +100,10 @@ void
 Yap_InitSWIHash(void)
 {
   int i, j;
-  memset(SWI_ReverseHash, 0, N_SWI_HASH*sizeof(swi_rev_hash));
   for (i=0; i < N_SWI_ATOMS; i++) {
-    add_to_hash(i, (ADDR)SWI_Atoms[i]);
+    Yap_PutAtomTranslation( SWI_Atoms[i], i );
   }
+  AtomTranslations = N_SWI_ATOMS;
   for (j=0; j < N_SWI_FUNCTORS; j++) {
     add_to_hash(j, (ADDR)SWI_Functors[j]);
   }

library/dialect/swi/fli/swi.h

@@ -60,6 +60,7 @@ typedef struct open_query_struct {
 static inline void
 add_to_hash(Int i, ADDR key)
 {
+
   UInt h = addr_hash(key);
   while (SWI_ReverseHash[h].key) {
     h = (h+1)%N_SWI_HASH;
@@ -85,16 +86,18 @@ static inline atom_t
 AtomToSWIAtom(Atom at)
 {
   atom_t ats;
-  if ((ats = in_hash((ADDR)at)))
-    return (atom_t)((CELL)ats*2+1);
+  TranslationEntry *p;
+
+  if ((p = Yap_GetTranslationProp(at)) != NULL)
+    return (atom_t)(p->Translation*2+1);
   return (atom_t)at;
 }
 
 static inline Atom
 SWIAtomToAtom(atom_t at)
 {
-  if ((CELL)at < N_SWI_ATOMS*(LowTagBits+1))
-    return SWI_Atoms[((CELL)at)/2];
+  if ((CELL)at < 2*N_SWI_ATOMS+1)
+    return SWI_Atoms[at/2];
   return (Atom)at;
 }
 

misc/HEAPFIELDS

@@ -336,10 +336,15 @@ ADDR		foreign_code_max	ForeignCodeMax		=NULL void
 struct record_list *yap_records		Yap_Records		=NULL		RestoreYapRecords()
 
 /* SWI atoms and functors */
-Atom		swi_atoms[N_SWI_ATOMS]	SWI_Atoms		InitSWIAtoms() RestoreSWIAtoms()
+Atom		swi_atoms[2*N_SWI_ATOMS]	SWI_Atoms		InitSWIAtoms() RestoreSWIAtoms()
 Functor		swi_functors[N_SWI_FUNCTORS] SWI_Functors	void void
+
 struct swi_reverse_hash	swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash	void void
 
+/* integer access to atoms */
+Int            atom_translations	AtomTranslations	void  void
+Int            max_atom_translations	MaxAtomTranslations	=2*N_SWI_ATOMS 
+
 Atom		empty_wakeups[MAX_EMPTY_WAKEUPS]	EmptyWakeups		InitEmptyWakeups() RestoreEmptyWakeups()
 int		max_empty_wakeups	MaxEmptyWakeups		=0
 

packages/cuda/Makefile.in

@@ -0,0 +1,67 @@
+#
+# default base directory for YAP installation
+# (EROOT for architecture-dependent files)
+#
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+ROOTDIR = $(prefix)
+EROOTDIR = @exec_prefix@
+abs_top_builddir = @abs_top_builddir@
+#
+# where the binary should be
+#
+BINDIR = $(EROOTDIR)/bin
+#
+# where YAP should look for libraries
+#
+LIBDIR=@libdir@
+SHAREDIR=$(ROOTDIR)/share/Yap
+YAPLIBDIR=@libdir@/Yap
+#
+#
+CC=@CC@
+CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include  @CUDA_CPPFLAGS@
+LDFLAGS=@LDFLAGS@
+#
+#
+# You shouldn't need to change what follows.
+#
+INSTALL=@INSTALL@
+INSTALL_DATA=@INSTALL_DATA@
+INSTALL_PROGRAM=@INSTALL_PROGRAM@
+SHELL=/bin/sh
+RANLIB=@RANLIB@
+srcdir=@srcdir@
+SO=@SO@
+#4.1VPATH=@srcdir@:@srcdir@/OPTYap
+CWD=$(PWD)
+#
+
+BDD_PROLOG= \
+	$(srcdir)/cuda.yap
+
+OBJS=cuda.o
+SOBJS=cuda.@SO@
+
+#in some systems we just create a single object, in others we need to
+# create a libray
+
+all: $(SOBJS) 
+
+cuda.o: $(srcdir)/cuda.c
+	$(CC) -c $(CFLAGS) $(srcdir)/cuda.c -o cuda.o
+
+@DO_SECOND_LD@%.@SO@: %.o
+@DO_SECOND_LD@	@SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@  @CUDA_LDFLAGS@
+
+@DO_SECOND_LD@cuda.@SO@: cuda.o
+@DO_SECOND_LD@	@SHLIB_LD@ $(LDFLAGS) -o cuda.@SO@ cuda.o @EXTRA_LIBS_FOR_DLLS@  @CUDA_LDFLAGS@
+
+install: all
+	mkdir -p $(DESTDIR)$(SHAREDIR)
+	for h in $(BDD_PROLOG); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done
+	$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
+
+clean:
+	rm -f *.o *~ $(OBJS) $(SOBJS) *.BAK
+

packages/cuda/cuda.c

@@ -0,0 +1,146 @@
+
+// interface to CUDD Datalog evaluation
+#include <stdio.h>
+#include <stdlib.h>
+#include "config.h"
+#include "YapInterface.h"
+
+void Cuda_Initialize( void );
+
+void *Cuda_NewFacts(int nrows, int ncols, int mat[]);
+
+void *Cuda_NewRule(int nrows, int ncols, int vec[], int len);
+
+void init_cuda( void );
+
+static void
+dump_mat(int mat[], int nrows, int ncols)
+{
+  int i, j;
+  for ( i=0; i< nrows; i++) {
+    printf("%d", mat[i*ncols]);
+    for (j=1; j < ncols; j++) {
+      printf(", %d", mat[i*ncols+j]);
+    }
+    printf("\n");
+  }
+}
+
+static void
+dump_vec(int vec[], int sz)
+{
+  int i;
+  printf("%d", vec[0]);
+  for ( i=1; i< sz; i++) {
+    printf(", %d", vec[i]);
+  }
+  printf("\n");
+}
+
+// stubs, for now.
+
+void Cuda_Initialize( void )
+{
+}
+
+void *Cuda_NewFacts(int nrows, int ncols, int mat[])
+{
+  dump_mat( mat, nrows, ncols );
+  return NULL;
+}
+
+void *Cuda_NewRule(int nrows, int ncols, int vec[], int len)
+{
+  dump_vec(vec, len);
+  return NULL;
+}
+
+static int
+p_load_facts( void ) {
+
+  int nrows = YAP_IntOfTerm(YAP_ARG1);
+  int ncols = YAP_IntOfTerm(YAP_ARG2), i = 0;
+  int *mat = (int *)malloc(sizeof(int)*nrows*ncols);
+  YAP_Term t3 = YAP_ARG3;
+  void *cudaobj;
+
+  while(YAP_IsPairTerm(t3)) {
+    int j = 0;
+    YAP_Term th = YAP_HeadOfTerm(t3);
+
+    for (j = 0; j < ncols; j++) {
+      YAP_Term ta = YAP_ArgOfTerm(j+1, th);
+      if (YAP_IsAtomTerm(ta)) {
+	mat[i*ncols+j] = YAP_AtomToInt(YAP_AtomOfTerm(ta));
+      } else {
+	mat[i*ncols+j] = YAP_IntOfTerm(ta);
+      }
+    }
+    t3 = YAP_TailOfTerm( t3 );
+    i++;
+  }
+  cudaobj = Cuda_NewFacts(nrows, ncols, mat);
+  return YAP_Unify(YAP_ARG4, YAP_MkIntTerm((YAP_Int)cudaobj));
+}
+
+static int
+p_load_rule( void ) {
+  // maximum of 2K symbols per rule, should be enough for ILP
+  int vec[2048], *ptr = vec;
+  // qK different variables;
+  YAP_Term vars[1024];
+  int nvars = 0;
+
+  int ngoals = YAP_IntOfTerm(YAP_ARG1);   /* gives the number of goals */
+  int ncols = YAP_IntOfTerm(YAP_ARG2);
+  YAP_Term t3 = YAP_ARG3;
+  void *cudaobj;
+
+  while(YAP_IsPairTerm(t3)) {
+    int j = 0;
+    YAP_Term th = YAP_HeadOfTerm(t3);
+    YAP_Functor f = YAP_FunctorOfTerm( th );
+    int n = YAP_ArityOfFunctor( f ); 
+
+    *ptr++ = YAP_AtomToInt( YAP_NameOfFunctor( f ) );
+    for (j = 0; j < n; j++) {
+      YAP_Term ta = YAP_ArgOfTerm(j+1, th);
+
+      if (YAP_IsVarTerm(ta)) {
+	int k;
+	for (k = 0; k< nvars; k++) {
+	  if (vars[k] == ta) {
+	    *ptr++ = k+1;
+	    break;
+	  }
+	}
+	if (k == nvars) {
+	  vars[k] = ta;
+	  *ptr++ = k+1;
+	  nvars++;
+	}
+      } else if (YAP_IsAtomTerm(ta))  {
+	*ptr++ = -YAP_AtomToInt(YAP_AtomOfTerm(ta));
+      } else {
+	*ptr++ = -YAP_IntOfTerm(ta);
+      }
+    }
+    *ptr++ = 0;
+    t3 = YAP_TailOfTerm( t3 );
+  }
+  cudaobj = Cuda_NewRule(ngoals, ncols, vec, ptr-vec);
+  return YAP_Unify(YAP_ARG4, YAP_MkIntTerm((YAP_Int)cudaobj));
+}
+
+static int first_time = TRUE;
+
+void
+init_cuda(void)
+{
+  if (first_time) Cuda_Initialize();
+  first_time = FALSE;
+
+  YAP_UserCPredicate("load_facts", p_load_facts, 4);
+  YAP_UserCPredicate("load_rule", p_load_rule, 4);
+}
+

packages/cuda/cuda.yap

@@ -0,0 +1,29 @@
+:- module(bdd, [cuda_extensional/2,
+	cuda_rule/2]).
+
+tell_warning :-
+	print_message(warning,functionality(cuda)).
+
+:- catch(load_foreign_files([cuda], [], init_cuda),_,fail) -> true ; tell_warning.
+
+:- meta_predicate cudda_extensional(:,-).
+
+cuda_extensional( Call, IdFacts) :-
+	strip_module(Call, Mod, Name/Arity),
+	functor(S, Name, Arity),
+	findall( S, Mod:S, L),
+	length( L, N ),
+	load_facts( N, Arity, L, IdFacts ).
+
+cuda_rule((Head :- Body) , IdRules) :-
+	body_to_list( Body, L, [], 1, N),
+	functor(Head, Na, Ar),
+	load_rule( N, Arity, [Head|L], IdRules ).
+
+
+body_to_list( (B1, B2), LF, L0, N0, N) :- !,
+	body_to_list( B1, LF, LI, N0, N1), 
+	body_to_list( B2, LI, L0, N1, NF). 
+body_to_list( B, [B|L], L, N0, N) :-
+	N is N0+1.
+

packages/cuda/test.yap

@@ -0,0 +1,15 @@
+
+:- use_module(library(cuda)).
+
+:- initialization(main).
+
+main :-
+	cuda_extensional(db/2, _X),
+	cuda_rule((a(X, Y) :- db(Y, Z), db(X, Z), db(1, Z) ), _).
+
+db(1,a).
+db(2,a).
+db(5,b).
+db(4,q).
+db(6,w).
+db(10,s).