improve blob support (but just skeleton).

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;

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 */

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

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;

H/ihstruct.h

@@ -300,3 +300,5 @@
   InitSWIAtoms();
 
 
+
+  Yap_heap_regs->swi_blobs = NULL;

H/rheap.h

@@ -668,6 +668,11 @@ RestoreSWIAtoms(void)
   RestoreSWIHash();
 }
 
+static void 
+RestoreSWIBlobs(void)
+{
+}
+
 static void
 RestorePredHash(void)
 {

H/rhstruct.h

@@ -300,3 +300,5 @@
   RestoreSWIAtoms();
 
 
+
+  RestoreSWIBlobs();

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
+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  $(srcdir)/library/yap2swi/yap2swi.c  -o $@
+	$(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 $@

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

library/yap2swi/yap2swi.c

@@ -45,128 +45,7 @@
 #include <fcntl.h>
 #endif
 
-/* Required by PL_error */
+#include "swi.h"
-#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;
-}
 
 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);
 }
 

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()