diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

This commit is contained in:
Theofrastos Mantadelis 2010-11-30 19:17:48 +01:00
parent 611af95e43 94194209ec
commit 28026e8cb3
25 changed files with 401 additions and 312 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
C/c_interface.c
View File

@ -1162,6 +1162,8 @@ typedef Int (*CPredicate5)(Int,Int,Int,Int,Int);
typedef Int (*CPredicate6)(Int,Int,Int,Int,Int,Int);
typedef Int (*CPredicate7)(Int,Int,Int,Int,Int,Int,Int);
typedef Int (*CPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int);
typedef Int (*CPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int);
typedef Int (*CPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int);
typedef Int (*CPredicateV)(Int,Int,struct foreign_context *);
static Int
@ -1241,6 +1243,33 @@ execute_cargs(PredEntry *pe, CPredicate exec_code)
Yap_InitSlot(Deref(ARG7)),
Yap_InitSlot(Deref(ARG8))));
}
case 9:
{
CPredicate9 code9 = (CPredicate9)exec_code;
return ((code9)(Yap_InitSlot(Deref(ARG1)),
Yap_InitSlot(Deref(ARG2)),
Yap_InitSlot(Deref(ARG3)),
Yap_InitSlot(Deref(ARG4)),
Yap_InitSlot(Deref(ARG5)),
Yap_InitSlot(Deref(ARG6)),
Yap_InitSlot(Deref(ARG7)),
Yap_InitSlot(Deref(ARG8)),
Yap_InitSlot(Deref(ARG9))));
}
case 10:
{
CPredicate10 code10 = (CPredicate10)exec_code;
return ((code10)(Yap_InitSlot(Deref(ARG1)),
Yap_InitSlot(Deref(ARG2)),
Yap_InitSlot(Deref(ARG3)),
Yap_InitSlot(Deref(ARG4)),
Yap_InitSlot(Deref(ARG5)),
Yap_InitSlot(Deref(ARG6)),
Yap_InitSlot(Deref(ARG7)),
Yap_InitSlot(Deref(ARG8)),
Yap_InitSlot(Deref(ARG9)),
Yap_InitSlot(Deref(ARG10))));
}
default:
return(FALSE);
}
@ -1255,6 +1284,8 @@ typedef Int (*CBPredicate5)(Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate6)(Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate7)(Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
static Int
execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *ctx)
@ -1340,6 +1371,35 @@ execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *
Yap_InitSlot(Deref(ARG8)),
ctx));
}
case 9:
{
CBPredicate9 code9 = (CBPredicate9)exec_code;
return ((code9)(Yap_InitSlot(Deref(ARG1)),
Yap_InitSlot(Deref(ARG2)),
Yap_InitSlot(Deref(ARG3)),
Yap_InitSlot(Deref(ARG4)),
Yap_InitSlot(Deref(ARG5)),
Yap_InitSlot(Deref(ARG6)),
Yap_InitSlot(Deref(ARG7)),
Yap_InitSlot(Deref(ARG8)),
Yap_InitSlot(Deref(ARG9)),
ctx));
}
case 10:
{
CBPredicate10 code10 = (CBPredicate10)exec_code;
return ((code10)(Yap_InitSlot(Deref(ARG1)),
Yap_InitSlot(Deref(ARG2)),
Yap_InitSlot(Deref(ARG3)),
Yap_InitSlot(Deref(ARG4)),
Yap_InitSlot(Deref(ARG5)),
Yap_InitSlot(Deref(ARG6)),
Yap_InitSlot(Deref(ARG7)),
Yap_InitSlot(Deref(ARG8)),
Yap_InitSlot(Deref(ARG9)),
Yap_InitSlot(Deref(ARG10)),
ctx));
}
default:
return(FALSE);
}
@ -1375,7 +1435,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
ctx->control = FRG_FIRST_CALL;
ctx->engine = NULL; //(PL_local_data *)Yap_regp;
ctx->context = NULL;

55
C/load_foreign.c
View File

@ -111,10 +111,10 @@ p_load_foreign(void)
static Int
p_open_shared_object(void) {
StringList ofiles = NULL;
Term t = Deref(ARG1);
Term tflags = Deref(ARG2);
void *ptr;
char *s;
void *handle;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"open_shared_object/3");
@ -129,35 +129,22 @@ p_open_shared_object(void) {
Yap_Error(INSTANTIATION_ERROR,tflags,"open_shared_object/3");
return FALSE;
}
if (!IsIntTerm(tflags)) {
if (!IsIntegerTerm(tflags)) {
Yap_Error(TYPE_ERROR_INTEGER,tflags,"open_shared_object/3");
return FALSE;
}
ofiles = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
ofiles->next = NULL;
ofiles->s = RepAtom(AtomOfTerm(t))->StrOfAE;
if ((ptr = Yap_LoadForeignFile(ofiles->s, IntOfTerm(tflags)))==NULL) {
return FALSE;
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if ((handle = Yap_LoadForeignFile(s, IntegerOfTerm(tflags)))==NULL) {
return FALSE;
} else {
ForeignObj *f_code = (ForeignObj *)Yap_AllocCodeSpace(sizeof(ForeignObj));
ofiles->handle = ptr;
f_code->objs = ofiles;
f_code->libs = NULL;
f_code->f = NULL;
f_code->next = ForeignCodeLoaded;
f_code->module = CurrentModule;
ForeignCodeLoaded = f_code;
return Yap_unify(MkIntegerTerm((Int)f_code),ARG3);
return Yap_unify(MkIntegerTerm((Int)handle),ARG3);
}
}
static Int
p_close_shared_object(void) {
Term t = Deref(ARG1);
ForeignObj *f, *f0 = NULL, *fi = ForeignCodeLoaded;
void *handle;
if (IsVarTerm(t)) {
@ -168,30 +155,15 @@ p_close_shared_object(void) {
Yap_Error(TYPE_ERROR_INTEGER,t,"open_shared_object/3");
return FALSE;
}
f = (ForeignObj *)IntegerOfTerm(t);
handle = (char *)IntegerOfTerm(t);
while (fi != f && fi) {
f0 = fi;
fi = f->next;
}
if (!fi)
return FALSE;
if (f0) {
f0->next = f->next;
} else {
ForeignCodeLoaded = f->next;
}
handle = f->objs->handle;
Yap_FreeCodeSpace((ADDR)f->objs);
Yap_FreeCodeSpace((ADDR)f);
return Yap_CloseForeignFile(f->f);
return Yap_CloseForeignFile(handle);
}
static Int
p_call_shared_object_function(void) {
Term t = Deref(ARG1);
Term tfunc = Deref(ARG2);
ForeignObj *f, *f0 = NULL, *fi = ForeignCodeLoaded;
void *handle;
if (IsVarTerm(t)) {
@ -202,7 +174,7 @@ p_call_shared_object_function(void) {
Yap_Error(TYPE_ERROR_INTEGER,t,"open_shared_object/3");
return FALSE;
}
f = (ForeignObj *)IntegerOfTerm(t);
handle = (void *)IntegerOfTerm(t);
if (IsVarTerm(tfunc)) {
Yap_Error(INSTANTIATION_ERROR,t,"open_shared_object/3");
return FALSE;
@ -212,13 +184,6 @@ p_call_shared_object_function(void) {
return FALSE;
}
while (fi != f && fi) {
f0 = fi;
fi = f->next;
}
if (!fi)
return FALSE;
handle = f->objs->handle;
return Yap_CallForeignFile(handle, RepAtom(AtomOfTerm(tfunc))->StrOfAE);
}

49
C/save.c
View File

@ -97,7 +97,7 @@ STATIC_PROTO(int save_heap, (void));
STATIC_PROTO(int save_stacks, (int));
STATIC_PROTO(int save_crc, (void));
STATIC_PROTO(Int do_save, (int));
STATIC_PROTO(Int p_save, (void));
STATIC_PROTO(Int p_save2, (void));
STATIC_PROTO(Int p_save_program, (void));
STATIC_PROTO(int check_header, (CELL *, CELL *, CELL *, CELL *));
STATIC_PROTO(int get_heap_info, (void));
@ -606,49 +606,36 @@ do_save(int mode) {
/* Saves a complete prolog environment */
static Int
p_save(void)
p_save2(void)
{
Int res;
Term t;
#if defined(YAPOR) && !defined(THREADS)
if (number_workers != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running");
Yap_Error(SYSTEM_ERROR,TermNil,
"cannot perform save: more than a worker/thread running");
return(FALSE);
}
#elif defined(THREADS)
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running");
Yap_Error(SYSTEM_ERROR,TermNil,
"cannot perform save: more than a worker/thread running");
return(FALSE);
}
#endif
which_save = 1;
/* avoid double saves */
if (IsNonVarTerm(t = Deref(ARG2)))
return TRUE;
if (!Yap_unify(ARG2,MkIntTerm(1)))
return FALSE;
which_save = 2;
Yap_StartSlots();
res = do_save(DO_EVERYTHING);
Yap_CloseSlots();
return res;
}
/* Saves a complete prolog environment */
static Int
p_save2(void)
{
#if defined(YAPOR) && !defined(THREADS)
if (number_workers != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,
"cannot perform save: more than a worker/thread running");
return(FALSE);
}
#elif defined(THREADS)
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,
"cannot perform save: more than a worker/thread running");
return(FALSE);
}
#endif
which_save = 2;
return(do_save(DO_EVERYTHING) && Yap_unify(ARG2,MkIntTerm(1)));
}
/* Just save the program, not the stacks */
static Int
p_save_program(void)
@ -1778,6 +1765,7 @@ static Int
p_restore(void)
{
int mode;
char s[YAP_FILENAME_MAX+1];
Term t1 = Deref(ARG1);
#if defined(YAPOR) && !defined(THREADS)
@ -1791,11 +1779,11 @@ p_restore(void)
return(FALSE);
}
#endif
if (!Yap_GetName(Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
if (!Yap_GetName(s, YAP_FILENAME_MAX, t1)) {
Yap_Error(TYPE_ERROR_LIST,t1,"restore/1");
return(FALSE);
}
if ((mode = Restore(Yap_FileNameBuf, NULL)) == DO_ONLY_CODE) {
if ((mode = Restore(s, NULL)) == DO_ONLY_CODE) {
#if PUSH_REGS
restore_absmi_regs(&Yap_standard_regs);
#endif
@ -1808,8 +1796,7 @@ p_restore(void)
void
Yap_InitSavePreds(void)
{
Yap_InitCPred("$save", 1, p_save, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$save", 2, p_save2, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$save_program", 1, p_save_program, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$save", 2, p_save2, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$save_program", 1, p_save_program, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$restore", 1, p_restore, SyncPredFlag|HiddenPredFlag);
}

4
H/Atoms.h
View File

@ -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
View File

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

2
H/dglobals.h
View File

@ -217,3 +217,5 @@
#define Yap_PL_Argc Yap_global->pl_argc
#define Yap_PL_Argv Yap_global->pl_argv
#define Yap_HaltHooks Yap_global->yap_halt_hook

4
H/dhstruct.h
View File

@ -263,8 +263,6 @@
#define Stream Yap_heap_regs->yap_streams
#define Yap_HaltHooks Yap_heap_regs->yap_halt_hook
#define NOfFileAliases Yap_heap_regs->n_of_file_aliases
#define SzOfFileAliases Yap_heap_regs->sz_of_file_aliases
#define FileAliases Yap_heap_regs->file_aliases
@ -302,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

2
H/hglobals.h
View File

@ -218,4 +218,6 @@ typedef struct worker_shared {
int initialised_from_pl;
int pl_argc;
char **pl_argv;
struct halt_hook *yap_halt_hook;
} w_shared;

4
H/hstruct.h
View File

@ -263,8 +263,6 @@
struct stream_desc *yap_streams;
struct halt_hook *yap_halt_hook;
UInt n_of_file_aliases;
UInt sz_of_file_aliases;
struct AliasDescS *file_aliases;
@ -302,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;

2
H/iglobals.h
View File

@ -216,4 +216,6 @@ static void InitGlobal(void) {
Yap_global->initialised_from_pl = FALSE;
Yap_global->pl_argc = 0;
Yap_global->pl_argv = NULL;
Yap_global->yap_halt_hook = NULL;
}

4
H/ihstruct.h
View File

@ -263,8 +263,6 @@
Yap_heap_regs->yap_streams = NULL;
Yap_heap_regs->yap_halt_hook = NULL;
Yap_heap_regs->n_of_file_aliases = 0;
Yap_heap_regs->sz_of_file_aliases = 0;
Yap_heap_regs->file_aliases = NULL;
@ -302,3 +300,5 @@
InitSWIAtoms();
Yap_heap_regs->swi_blobs = NULL;

2
H/rglobals.h
View File

@ -216,4 +216,6 @@ static void RestoreGlobal(void) {
}

17
H/rheap.h
View File

@ -668,6 +668,11 @@ RestoreSWIAtoms(void)
RestoreSWIHash();
}
static void
RestoreSWIBlobs(void)
{
}
static void
RestorePredHash(void)
{
@ -903,18 +908,6 @@ RestoreDBErasedIList(void)
}
}
static void
RestoreHaltHooks(void)
{
struct halt_hook *hooke = Yap_HaltHooks = HaltHookAdjust(Yap_HaltHooks);
while (hooke) {
hooke->next = HaltHookAdjust(hooke->next);
hooke = hooke->next;
}
}
static void
RestoreStreams(void)
{

4
H/rhstruct.h
View File

@ -263,8 +263,6 @@
RestoreStreams();
RestoreHaltHooks();
RestoreAliases();
@ -302,3 +300,5 @@
RestoreSWIAtoms();
RestoreSWIBlobs();

14
Makefile.in
View File

@ -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 \
@ -260,7 +261,9 @@ PL_SOURCES= \
$(srcdir)/pl/load_foreign.yap \
$(srcdir)/pl/modules.yap $(srcdir)/pl/preds.yap \
$(srcdir)/pl/profile.yap \
$(srcdir)/pl/protect.yap $(srcdir)/pl/setof.yap \
$(srcdir)/pl/protect.yap \
$(srcdir)/pl/save.yap \
$(srcdir)/pl/setof.yap \
$(srcdir)/pl/signals.yap \
$(srcdir)/pl/sockets.yap $(srcdir)/pl/sort.yap \
$(srcdir)/pl/statistics.yap \
@ -290,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 \
@ -454,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 $@

2
console/yap.c
View File

@ -732,7 +732,7 @@ main (int argc, char **argv)
exit(1);
}
/* Begin preprocessor code */
{
if (BootMode != YAP_BOOT_FROM_SAVED_STACKS) {
// load the module
YAP_Term mod_arg[1];
mod_arg[0] = YAP_MkAtomTerm(YAP_LookupAtom("ypp"));

87
include/SWI-Prolog.h
View File

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

162
library/yap2swi/yap2swi.c
View File

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

3
misc/GLOBALS
View File

@ -245,5 +245,8 @@ int initialised_from_pl Yap_InitialisedFromPL =FALSE
int pl_argc Yap_PL_Argc =0
char **pl_argv Yap_PL_Argv =NULL
// halt hooks
struct halt_hook *yap_halt_hook Yap_HaltHooks =NULL
END_WORKER_SHARED

6
misc/HEAPFIELDS
View File

@ -295,9 +295,6 @@ struct operator_entry *op_list OpList =NULL OpListAdjust
/* stream array */
struct stream_desc *yap_streams Stream =NULL RestoreStreams()
/* halt hooks */
struct halt_hook *yap_halt_hook Yap_HaltHooks =NULL RestoreHaltHooks()
/* stream aliases */
UInt n_of_file_aliases NOfFileAliases =0 void
UInt sz_of_file_aliases SzOfFileAliases =0 void
@ -345,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()

7
pl/boot.yap
View File

@ -159,6 +159,13 @@ true :- true.
'$enter_top_level' :-
'$clean_up_dead_clauses',
fail.
% use if we come from a save_program and we have SWI's shlib
'$enter_top_level' :-
recorded('$reload_foreign_libraries',G,R),
erase(R),
shlib:reload_foreign_libraries,
fail.
% use if we come from a save_program and we have a goal to execute
'$enter_top_level' :-
recorded('$restore_goal',G,R),
erase(R),

1
pl/init.yap
View File

@ -72,6 +72,7 @@ otherwise.
'profile.yap',
'callcount.yap',
'load_foreign.yap',
'save.yap',
'sockets.yap',
'sort.yap',
'setof.yap',

83
pl/save.yap Normal file
View File

@ -0,0 +1,83 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2010 *
* *
**************************************************************************
* *
* File: save.yap *
* Last rev: 11/29/10 *
* mods: *
* comments: Some utility predicates to support save/restore in yap *
* *
*************************************************************************/
%%% Saving and restoring a computation
save(A) :- save(A,_).
save(A,_) :- var(A), !,
'$do_error'(instantiation_error,save(A)).
save(A,OUT) :- atom(A), !, atom_codes(A,S), '$save'(S,OUT).
save(S,OUT) :- '$save'(S,OUT).
save_program(A) :- var(A), !,
'$do_error'(instantiation_error,save_program(A)).
save_program(A) :- atom(A), !,
atom_codes(A,S),
'$save_program2'(S, true).
save_program(S) :- '$save_program2'(S, true).
save_program(A, G) :- var(A), !,
'$do_error'(instantiation_error, save_program(A,G)).
save_program(A, G) :- var(G), !,
'$do_error'(instantiation_error, save_program(A,G)).
save_program(A, G) :- \+ callable(G), !,
'$do_error'(type_error(callable,G), save_program(A,G)).
save_program(A, G) :-
( atom(A) -> atom_codes(A,S) ; A = S),
'$save_program2'(S, G),
fail.
save_program(_,_).
'$save_program2'(S,G) :-
(
G == true
->
true
;
recorda('$restore_goal', G ,R)
),
(
'$undefined'(reload_foreign_libraries, shlib)
->
true
;
recorda('$reload_foreign_libraries', true, R1)
),
'$save_program'(S),
(
var(R1)
->
true
;
erase(R1)
),
(
var(R)
->
true
;
erase(R)
),
fail.
'$save_program2'(_,_).
restore(A) :- var(A), !,
'$do_error'(instantiation_error,restore(A)).
restore(A) :- atom(A), !, name(A,S), '$restore'(S).
restore(S) :- '$restore'(S).

6
pl/udi.yap
View File

@ -4,14 +4,14 @@
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2010 *
* *
**************************************************************************
* *
* File: tabling.yap *
* File: udi.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: support tabling predicates *
* comments: support user defined indexing *
* *
*************************************************************************/

58
pl/utils.yap
View File

@ -307,35 +307,65 @@ getenv(Na,Val) :-
%%% Saving and restoring a computation
save(A) :- var(A), !,
'$do_error'(instantiation_error,save(A)).
save(A) :- atom(A), !, name(A,S), '$save'(S).
save(S) :- '$save'(S).
save(A) :- save(A,_).
save(A,_) :- var(A), !,
'$do_error'(instantiation_error,save(A)).
save(A,OUT) :- atom(A), !, name(A,S), '$save'(S,OUT).
save(A,OUT) :- atom(A), !, atom_codes(A,S), '$save'(S,OUT).
save(S,OUT) :- '$save'(S,OUT).
save_program(A) :- var(A), !,
'$do_error'(instantiation_error,save_program(A)).
save_program(A) :- atom(A), !, name(A,S), '$save_program'(S).
save_program(S) :- '$save_program'(S).
save_program(A) :- atom(A), !,
atom_codes(A,S),
'$save_program2'(S, true).
save_program(S) :- '$save_program2'(S, true).
save_program(A, G) :- var(A), !,
'$do_error'(instantiation_error,save_program(A,G)).
'$do_error'(instantiation_error, save_program(A,G)).
save_program(A, G) :- var(G), !,
'$do_error'(instantiation_error,save_program(A,G)).
'$do_error'(instantiation_error, save_program(A,G)).
save_program(A, G) :- \+ callable(G), !,
'$do_error'(type_error(callable,G),save_program(A,G)).
'$do_error'(type_error(callable,G), save_program(A,G)).
save_program(A, G) :-
( atom(A) -> name(A,S) ; A = S),
recorda('$restore_goal',G,R),
'$save_program'(S),
erase(R),
( atom(A) -> atom_codes(A,S) ; A = S),
'$save_program2'(S, G),
fail.
save_program(_,_).
'$save_program2'(S,G) :-
(
G == true
->
true
;
recorda('$restore_goal', G ,R)
),
(
'$undefined'(reload_foreign_libraries, shlib)
->
true
;
recorda('$reload_foreign_libraries', true, R1)
),
'$save_program'(S),
(
var(R1)
->
true
;
erase(R1)
),
(
var(R)
->
true
;
erase(R)
),
fail.
'$save_program2'(_,_).
restore(A) :- var(A), !,
'$do_error'(instantiation_error,restore(A)).
restore(A) :- atom(A), !, name(A,S), '$restore'(S).