From 43163a190f88e19381d1c966feb06929bbcbf349 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 4 Oct 2013 13:22:00 +0100 Subject: [PATCH] Atom Translations and CUDA stub --- C/adtdefs.c | 24 ++++++ C/c_interface.c | 20 +++++ H/Yatom.h | 82 ++++++++++++++++++- H/dhstruct.h | 3 + H/hstruct.h | 5 +- H/ihstruct.h | 3 + H/rheap.h | 9 ++- H/rhstruct.h | 3 + configure | 57 ++++++++----- configure.in | 42 ++++++---- library/dialect/swi/fli/swi.c | 4 +- library/dialect/swi/fli/swi.h | 11 ++- misc/HEAPFIELDS | 7 +- packages/cuda/Makefile.in | 67 ++++++++++++++++ packages/cuda/cuda.c | 146 ++++++++++++++++++++++++++++++++++ packages/cuda/cuda.yap | 29 +++++++ packages/cuda/test.yap | 15 ++++ 17 files changed, 481 insertions(+), 46 deletions(-) create mode 100644 packages/cuda/Makefile.in create mode 100644 packages/cuda/cuda.c create mode 100644 packages/cuda/cuda.yap create mode 100644 packages/cuda/test.yap diff --git a/C/adtdefs.c b/C/adtdefs.c index f2c391a9b..7a52f652a 100755 --- a/C/adtdefs.c +++ b/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) { diff --git a/C/c_interface.c b/C/c_interface.c index bb6ab402b..7754f717a 100644 --- a/C/c_interface.c +++ b/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]; +} + diff --git a/H/Yatom.h b/H/Yatom.h index 17ba7366c..ce8f86021 100644 --- a/H/Yatom.h +++ b/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)); } diff --git a/H/dhstruct.h b/H/dhstruct.h index 6d705b956..62452cc40 100644 --- a/H/dhstruct.h +++ b/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 diff --git a/H/hstruct.h b/H/hstruct.h index a13deaddf..b15689c39 100644 --- a/H/hstruct.h +++ b/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; diff --git a/H/ihstruct.h b/H/ihstruct.h index 3f5d3e958..67e82f642 100644 --- a/H/ihstruct.h +++ b/H/ihstruct.h @@ -298,6 +298,9 @@ InitSWIAtoms(); + + + MaxAtomTranslations = 2*N_SWI_ATOMS; InitEmptyWakeups(); MaxEmptyWakeups = 0; diff --git a/H/rheap.h b/H/rheap.h index 6d411e635..542cdf304 100644 --- a/H/rheap.h +++ b/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; diff --git a/H/rhstruct.h b/H/rhstruct.h index 5eac3e469..43fe14b91 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -298,6 +298,9 @@ RestoreSWIAtoms(); + + + RestoreEmptyWakeups(); diff --git a/configure b/configure index db4b58a1e..cc10dccf6 100755 --- a/configure +++ b/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 diff --git a/configure.in b/configure.in index 22a629314..151479741 100755 --- a/configure.in +++ b/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() diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index bf9064c11..ebba54c76 100755 --- a/library/dialect/swi/fli/swi.c +++ b/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]); } diff --git a/library/dialect/swi/fli/swi.h b/library/dialect/swi/fli/swi.h index 673cefd60..f47e6b221 100644 --- a/library/dialect/swi/fli/swi.h +++ b/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; } diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index 4b70c98b7..be0433024 100644 --- a/misc/HEAPFIELDS +++ b/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 diff --git a/packages/cuda/Makefile.in b/packages/cuda/Makefile.in new file mode 100644 index 000000000..c950ad774 --- /dev/null +++ b/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 + diff --git a/packages/cuda/cuda.c b/packages/cuda/cuda.c new file mode 100644 index 000000000..5b1354e37 --- /dev/null +++ b/packages/cuda/cuda.c @@ -0,0 +1,146 @@ + +// interface to CUDD Datalog evaluation +#include +#include +#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); +} + diff --git a/packages/cuda/cuda.yap b/packages/cuda/cuda.yap new file mode 100644 index 000000000..3cb60dfdd --- /dev/null +++ b/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. + diff --git a/packages/cuda/test.yap b/packages/cuda/test.yap new file mode 100644 index 000000000..fb0cc8cc5 --- /dev/null +++ b/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).