From 7b6f330bd3781bf7464da53735be2a6392e00505 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 29 Nov 2010 23:17:06 +0000 Subject: [PATCH] improve blob support (but just skeleton). --- H/Atoms.h | 4 + H/Yatom.h | 73 +++++++++++++++++ H/dhstruct.h | 2 + H/hstruct.h | 2 + H/ihstruct.h | 2 + H/rheap.h | 5 ++ H/rhstruct.h | 2 + Makefile.in | 10 ++- include/SWI-Prolog.h | 87 +++++++++++++------- library/yap2swi/yap2swi.c | 162 +------------------------------------- misc/HEAPFIELDS | 3 + 11 files changed, 159 insertions(+), 193 deletions(-) diff --git a/H/Atoms.h b/H/Atoms.h index 0631be0a3..86fbc0bc5 100644 --- a/H/Atoms.h +++ b/H/Atoms.h @@ -55,6 +55,10 @@ typedef struct AtomEntryStruct union { char uStrOfAE[MIN_ARRAY]; /* representation of atom as a string */ wchar_t uWStrOfAE[MIN_ARRAY]; /* representation of atom as a string */ + struct { + size_t length; /* size of blob */ + char data[MIN_ARRAY]; /* data */ + } blob; } rep; } AtomEntry; diff --git a/H/Yatom.h b/H/Yatom.h index 143772878..ecaf3052b 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -1361,6 +1361,79 @@ IsArrayProperty (int flags) +/* SWI Blob property */ +typedef struct blob_atom_entry +{ + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + struct PL_blob_t *blob_t; /* type of blob */ +} BlobPropEntry; + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN BlobAtomEntry *RepBlobProp (Prop p); + +inline EXTERN BlobPropEntry * +RepBlobProp (Prop p) +{ + return (BlobPropEntry *) (AtomBase + Unsigned (p)); +} + + + +inline EXTERN AtomEntry *AbsBlobProp (BlobPropEntry * p); + +inline EXTERN Prop +AbsBlobProp (BlobPropEntry * p) +{ + return (Prop) (Addr (p) - AtomBase); +} + + +#else + +inline EXTERN BlobPropEntry *RepBlobProp (Prop p); + +inline EXTERN BlobPropEntry * +RepBlobProp (Prop p) +{ + return (BlobPropEntry *) (p); +} + + + +inline EXTERN Prop AbsBlobProp (BlobPropEntry * p); + +inline EXTERN Prop +AbsBlobProp (BlobPropEntry * p) +{ + return (Prop) (p); +} + + +#endif + +#define BlobProperty ((PropFlags)0xfff5) + + +inline EXTERN PropFlags IsBlobProperty (int); + +inline EXTERN PropFlags +IsBlobProperty (int flags) +{ + return (PropFlags) ((flags == BlobProperty)); +} + +inline EXTERN int IsBlob (Atom); + +inline EXTERN int +IsBlob (Atom at) +{ + return RepAtom(at)->PropsOfAE && + IsBlobProperty(RepBlobProp(RepAtom(at)->PropsOfAE)->KindOfPE); +} + + /* Proto types */ /* cdmgr.c */ diff --git a/H/dhstruct.h b/H/dhstruct.h index 6be01d069..1da642d95 100644 --- a/H/dhstruct.h +++ b/H/dhstruct.h @@ -300,3 +300,5 @@ #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 SWI_Blobs Yap_heap_regs->swi_blobs diff --git a/H/hstruct.h b/H/hstruct.h index 99b06b296..f74108565 100644 --- a/H/hstruct.h +++ b/H/hstruct.h @@ -300,3 +300,5 @@ Atom swi_atoms[N_SWI_ATOMS]; Functor swi_functors[N_SWI_FUNCTORS]; struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH]; + + struct PL_blob_t *swi_blobs; diff --git a/H/ihstruct.h b/H/ihstruct.h index a9e12a561..612d0af6d 100644 --- a/H/ihstruct.h +++ b/H/ihstruct.h @@ -300,3 +300,5 @@ InitSWIAtoms(); + + Yap_heap_regs->swi_blobs = NULL; diff --git a/H/rheap.h b/H/rheap.h index 127a32fd4..06176cd68 100755 --- a/H/rheap.h +++ b/H/rheap.h @@ -668,6 +668,11 @@ RestoreSWIAtoms(void) RestoreSWIHash(); } +static void +RestoreSWIBlobs(void) +{ +} + static void RestorePredHash(void) { diff --git a/H/rhstruct.h b/H/rhstruct.h index 5e04e4521..e92e86c56 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -300,3 +300,5 @@ RestoreSWIAtoms(); + + RestoreSWIBlobs(); diff --git a/Makefile.in b/Makefile.in index 4df75a563..3ba111384 100755 --- a/Makefile.in +++ b/Makefile.in @@ -224,6 +224,7 @@ C_SOURCES= \ $(srcdir)/library/lammpi/yap_mpi.c $(srcdir)/library/lammpi/hash.c $(srcdir)/library/lammpi/prologterms2c.c \ $(srcdir)/C/cut_c.c \ $(srcdir)/library/yap2swi/yap2swi.c \ + $(srcdir)/library/yap2swi/blobs.c \ $(srcdir)/MYDDAS/myddas_mysql.c \ $(srcdir)/MYDDAS/myddas_odbc.c \ $(srcdir)/MYDDAS/myddas_util.c \ @@ -292,7 +293,7 @@ ENGINE_OBJECTS = \ udi.o rtree.o rtree_udi.o\ unify.o userpreds.o utilpreds.o \ write.o \ - yap2swi.o ypsocks.o ypstdio.o @MPI_OBJS@ + blobs.o yap2swi.o ypsocks.o ypstdio.o @MPI_OBJS@ C_INTERFACE_OBJECTS = \ load_foreign.o load_dl.o load_dld.o load_dyld.o \ @@ -456,8 +457,11 @@ eamindex.o: $(srcdir)/BEAM/eamindex.c config.h sys.o: $(srcdir)/library/system/sys.c config.h $(CC) -c $(CFLAGS) -I$(srcdir)/include $(srcdir)/library/system/sys.c -o $@ -yap2swi.o: $(srcdir)/library/yap2swi/yap2swi.c config.h - $(CC) -c $(CFLAGS) -I$(srcdir)/include $(srcdir)/library/yap2swi/yap2swi.c -o $@ +yap2swi.o: $(srcdir)/library/yap2swi/yap2swi.c $(srcdir)/library/yap2swi/swi.h $(srcdir)/include/SWI-Prolog.h $(srcdir)/include/SWI-Stream.h config.h + $(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir)/library/yap2swi $(srcdir)/library/yap2swi/yap2swi.c -o $@ + +blobs.o: $(srcdir)/library/yap2swi/blobs.c $(srcdir)/library/yap2swi/swi.h $(srcdir)/include/SWI-Prolog.h config.h + $(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir)/library/yap2swi $(srcdir)/library/yap2swi/blobs.c -o $@ yap_random.o: $(srcdir)/library/random/yap_random.c config.h $(CC) -c $(CFLAGS) -I$(srcdir)/include $(srcdir)/library/random/yap_random.c -o $@ diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 5ccbdafd9..6c2863b30 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -314,33 +314,6 @@ typedef struct foreign_context *control_t; /* end from pl-itf.h */ -typedef struct PL_blob_t -{ uintptr_t magic; /* PL_BLOB_MAGIC */ - uintptr_t flags; /* PL_BLOB_* */ - char * name; /* name of the type */ - int (*release)(atom_t a); - int (*compare)(atom_t a, atom_t b); -#ifdef SIO_MAGIC - int (*write)(IOSTREAM *s, atom_t a, int flags); -#else - int (*write)(void *s, atom_t a, int flags); -#endif - void (*acquire)(atom_t a); -#ifdef SIO_MAGIC - int (*save)(atom_t a, IOSTREAM *s); - atom_t (*load)(IOSTREAM *s); -#else - int (*save)(atom_t a, void*); - atom_t (*load)(void *s); -#endif - /* private */ - void * reserved[10]; /* for future extension */ - int registered; /* Already registered? */ - int rank; /* Rank for ordering atoms */ - struct PL_blob_t * next; /* next in registered type-chain */ - atom_t atom_name; /* Name as atom */ -} PL_blob_t; - /******************************* * CALL-BACK * *******************************/ @@ -524,9 +497,6 @@ extern X_API size_t PL_utf8_strlen(const char *s, size_t len); extern X_API int PL_unify_list_codes(term_t l, const char *chars); -extern X_API int PL_is_blob(term_t t, PL_blob_t **type); -extern X_API void *PL_blob_data(term_t t, size_t *len, PL_blob_t **type); - #define PL_SIGSYNC 0x00010000 /* call handler synchronously */ #define PL_SIGNOFRAME 0x00020000 /* Do not create a Prolog frame */ @@ -623,6 +593,63 @@ PL_EXPORT(int) PL_write_term(IOSTREAM *s,term_t term,int precedence,int #endif + /******************************* + * BLOBS * + *******************************/ + +#define PL_BLOB_MAGIC_B 0x75293a00 /* Magic to validate a blob-type */ +#define PL_BLOB_VERSION 1 /* Current version */ +#define PL_BLOB_MAGIC (PL_BLOB_MAGIC_B|PL_BLOB_VERSION) + +#define PL_BLOB_UNIQUE 0x01 /* Blob content is unique */ +#define PL_BLOB_TEXT 0x02 /* blob contains text */ +#define PL_BLOB_NOCOPY 0x04 /* do not copy the data */ +#define PL_BLOB_WCHAR 0x08 /* wide character string */ + +typedef struct PL_blob_t +{ uintptr_t magic; /* PL_BLOB_MAGIC */ + uintptr_t flags; /* PL_BLOB_* */ + char * name; /* name of the type */ + int (*release)(atom_t a); + int (*compare)(atom_t a, atom_t b); +#ifdef SIO_MAGIC + int (*write)(IOSTREAM *s, atom_t a, int flags); +#else + int (*write)(void *s, atom_t a, int flags); +#endif + void (*acquire)(atom_t a); +#ifdef SIO_MAGIC + int (*save)(atom_t a, IOSTREAM *s); + atom_t (*load)(IOSTREAM *s); +#else + int (*save)(atom_t a, void*); + atom_t (*load)(void *s); +#endif + /* private */ + void * reserved[10]; /* for future extension */ + int registered; /* Already registered? */ + int rank; /* Rank for ordering atoms */ + struct PL_blob_t * next; /* next in registered type-chain */ + atom_t atom_name; /* Name as atom */ +} PL_blob_t; + +PL_EXPORT(int) PL_is_blob(term_t t, PL_blob_t **type); +PL_EXPORT(int) PL_unify_blob(term_t t, void *blob, size_t len, + PL_blob_t *type); +PL_EXPORT(int) PL_put_blob(term_t t, void *blob, size_t len, + PL_blob_t *type); +PL_EXPORT(int) PL_get_blob(term_t t, void **blob, size_t *len, + PL_blob_t **type); + +PL_EXPORT(void*) PL_blob_data(atom_t a, + size_t *len, + struct PL_blob_t **type); + +PL_EXPORT(void) PL_register_blob_type(PL_blob_t *type); +PL_EXPORT(PL_blob_t*) PL_find_blob_type(const char* name); +PL_EXPORT(int) PL_unregister_blob_type(PL_blob_t *type); + + #if USE_GMP PL_EXPORT(int) PL_get_mpz(term_t t, mpz_t mpz); diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index d1cf2e9ec..88480979d 100755 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -45,128 +45,7 @@ #include #endif -/* Required by PL_error */ -#define ERR_NO_ERROR 0 -#define ERR_INSTANTIATION 1 /* void */ -#define ERR_TYPE 2 /* atom_t expected, term_t value */ -#define ERR_DOMAIN 3 /* atom_t domain, term_t value */ -#define ERR_REPRESENTATION 4 /* atom_t what */ -#define ERR_MODIFY_STATIC_PROC 5 /* predicate_t proc */ -#define ERR_EVALUATION 6 /* atom_t what */ -#define ERR_AR_TYPE 7 /* atom_t expected, Number value */ -#define ERR_NOT_EVALUABLE 8 /* functor_t func */ -#define ERR_DIV_BY_ZERO 9 /* void */ -#define ERR_FAILED 10 /* predicate_t proc */ -#define ERR_FILE_OPERATION 11 /* atom_t action, atom_t type, term_t */ -#define ERR_PERMISSION 12 /* atom_t type, atom_t op, term_t obj*/ -#define ERR_NOT_IMPLEMENTED 13 /* const char *what */ -#define ERR_EXISTENCE 14 /* atom_t type, term_t obj */ -#define ERR_STREAM_OP 15 /* atom_t action, term_t obj */ -#define ERR_RESOURCE 16 /* atom_t resource */ -#define ERR_NOMEM 17 /* void */ -#define ERR_SYSCALL 18 /* void */ -#define ERR_SHELL_FAILED 19 /* term_t command */ -#define ERR_SHELL_SIGNALLED 20 /* term_t command, int signal */ -#define ERR_AR_UNDEF 21 /* void */ -#define ERR_AR_OVERFLOW 22 /* void */ -#define ERR_AR_UNDERFLOW 23 /* void */ -#define ERR_UNDEFINED_PROC 24 /* Definition def */ -#define ERR_SIGNALLED 25 /* int sig, char *name */ -#define ERR_CLOSED_STREAM 26 /* IOSTREAM * */ -#define ERR_BUSY 27 /* mutexes */ -#define ERR_PERMISSION_PROC 28 /* op, type, Definition */ -#define ERR_DDE_OP 29 /* op, error */ -#define ERR_SYNTAX 30 /* what */ -#define ERR_SHARED_OBJECT_OP 31 /* op, error */ -#define ERR_TIMEOUT 32 /* op, object */ -#define ERR_NOT_IMPLEMENTED_PROC 33 /* name, arity */ -#define ERR_FORMAT 34 /* message */ -#define ERR_FORMAT_ARG 35 /* seq, term */ -#define ERR_OCCURS_CHECK 36 /* Word, Word */ -#define ERR_CHARS_TYPE 37 /* char *, term */ -#define ERR_MUST_BE_VAR 38 /* int argn, term_t term */ - -typedef struct open_query_struct { - int open; - int state; - YAP_Term g; - yamop *p, *cp; - Int slots; - jmp_buf env; - struct open_query_struct *old; -} open_query; - -#define addr_hash(V) (((CELL) (V)) >> 4 & (N_SWI_HASH-1)) - -static void -add_to_hash(Int i, ADDR key) -{ - UInt h = addr_hash(key); - while (SWI_ReverseHash[h].key) { - h = (h+1)%N_SWI_HASH; - } - SWI_ReverseHash[h].key = key; - SWI_ReverseHash[h].pos = i; -} - -static atom_t -in_hash(ADDR key) -{ - UInt h = addr_hash(key); - while (SWI_ReverseHash[h].key) { - if (SWI_ReverseHash[h].key == key) - return SWI_ReverseHash[h].pos; - h = (h+1)%N_SWI_HASH; - } - return 0; -} - - -static inline atom_t -AtomToSWIAtom(Atom at) -{ - atom_t ats; - if ((ats = in_hash((ADDR)at))) - return ats; - return (atom_t)at; -} - -static inline Atom -SWIAtomToAtom(atom_t at) -{ - if ((CELL)at & 1) - return SWI_Atoms[at>>1]; - return (Atom)at; -} - -static inline Term -SWIModuleToModule(module_t m) -{ - if (m) - return (CELL)m; - if (CurrentModule) - return CurrentModule; - return USER_MODULE; -} - -static inline functor_t -FunctorToSWIFunctor(Functor at) -{ - atom_t ats; - if ((ats = in_hash((ADDR)at))) - return (functor_t)ats; - return (functor_t)at; -} - -static inline Functor -SWIFunctorToFunctor(functor_t at) -{ - if (IsAtomTerm(at)) - return (Functor)at; - if ((CELL)(at) & 2) - return SWI_Functors[((CELL)at)/4]; - return (Functor)at; -} +#include "swi.h" extern X_API Int YAP_PLArityOfSWIFunctor(functor_t at); @@ -3195,23 +3074,6 @@ typedef struct blob { CELL blob_data[1]; } blob_t; -X_API int -PL_is_blob(term_t ts, PL_blob_t **type) -{ - Term t = Yap_GetFromSlot(ts); - blob_t *b; - - if (IsVarTerm(t) || !IsApplTerm(t)) - return FALSE; - b = (blob_t *)RepAppl(t); - if (b->f != FunctorBigInt) - return FALSE; - if (b->type != EXTERNAL_BLOB) - return FALSE; - *type = b->blb; - return TRUE; -} - X_API intptr_t PL_query(int query) { @@ -3229,25 +3091,6 @@ PL_query(int query) } -X_API void * -PL_blob_data(term_t ts, size_t *len, PL_blob_t **type) -{ - Term t = Yap_GetFromSlot(ts); - blob_t *b; - - - if (IsVarTerm(t) || !IsApplTerm(t)) - return FALSE; - b = (blob_t *)RepAppl(t); - if (b->f != FunctorBigInt) - return NULL; - if (b->type != EXTERNAL_BLOB) - return NULL; - *type = b->blb; - *len = b->size; - return (void *)(&b->blob_data); -} - /* glue function to connect back PLStream to YAP IO */ X_API void PL_YAP_InitSWIIO(struct SWI_IO *swio) @@ -3273,11 +3116,10 @@ X_API void PL_on_halt(void (*f)(int, void *), void *closure) Yap_HaltRegisterHook((HaltHookFunc)f,closure); } -void Yap_swi_install(void); - void Yap_swi_install(void) { + Yap_install_blobs(); YAP_UserCPredicate("ctime", SWI_ctime, 2); } diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index a1ba72fa4..f578658ce 100644 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -342,3 +342,6 @@ ADDR foreign_code_max ForeignCodeMax =NULL void Atom swi_atoms[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 + +/* SWI blobs */ +struct PL_blob_t *swi_blobs SWI_Blobs =NULL RestoreSWIBlobs()