Merge ../yap-6.2
This commit is contained in:
commit
10a3d52de0
@ -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;
|
||||
|
73
H/Yatom.h
73
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 */
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -300,3 +300,5 @@
|
||||
InitSWIAtoms();
|
||||
|
||||
|
||||
|
||||
Yap_heap_regs->swi_blobs = NULL;
|
||||
|
@ -668,6 +668,11 @@ RestoreSWIAtoms(void)
|
||||
RestoreSWIHash();
|
||||
}
|
||||
|
||||
static void
|
||||
RestoreSWIBlobs(void)
|
||||
{
|
||||
}
|
||||
|
||||
static void
|
||||
RestorePredHash(void)
|
||||
{
|
||||
|
@ -300,3 +300,5 @@
|
||||
RestoreSWIAtoms();
|
||||
|
||||
|
||||
|
||||
RestoreSWIBlobs();
|
||||
|
10
Makefile.in
10
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 $@
|
||||
|
@ -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);
|
||||
|
@ -45,128 +45,7 @@
|
||||
#include <fcntl.h>
|
||||
#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);
|
||||
}
|
||||
|
||||
|
@ -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()
|
||||
|
Reference in New Issue
Block a user