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

C/c_interface.c

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

C/load_foreign.c

@@ -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));
+  s = RepAtom(AtomOfTerm(t))->StrOfAE;
-  ofiles->next = NULL;
+  if ((handle = Yap_LoadForeignFile(s, IntegerOfTerm(tflags)))==NULL) {
-  ofiles->s = RepAtom(AtomOfTerm(t))->StrOfAE;
+    return FALSE;
-  if ((ptr = Yap_LoadForeignFile(ofiles->s, IntOfTerm(tflags)))==NULL) {
-      return FALSE;
   } else {
-    ForeignObj *f_code = (ForeignObj *)Yap_AllocCodeSpace(sizeof(ForeignObj));
+    return Yap_unify(MkIntegerTerm((Int)handle),ARG3);
-    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);
   }
 }
 
 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) {
+  return Yap_CloseForeignFile(handle);
-    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);
 }
 
 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);
 }
 

C/save.c

@@ -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, SyncPredFlag|HiddenPredFlag);
-  Yap_InitCPred("$save", 2, p_save2, SafePredFlag|SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred("$save_program", 1, p_save_program, SyncPredFlag|HiddenPredFlag);
-  Yap_InitCPred("$save_program", 1, p_save_program, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$restore", 1, p_restore, SyncPredFlag|HiddenPredFlag);
 }

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/dglobals.h

@@ -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
+

H/dhstruct.h

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

H/hglobals.h

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

H/hstruct.h

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

H/iglobals.h

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

H/ihstruct.h

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

H/rglobals.h

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

H/rheap.h

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

H/rhstruct.h

@@ -263,8 +263,6 @@
 
   RestoreStreams();
 
-  RestoreHaltHooks();
-
 
 
   RestoreAliases();
@@ -302,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 \
@@ -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
+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 $@

console/yap.c

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

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

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

misc/HEAPFIELDS

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

pl/boot.yap

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

pl/init.yap

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

pl/save.yap

@@ -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).
+

pl/udi.yap

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

pl/utils.yap

@@ -307,35 +307,65 @@ getenv(Na,Val) :-
 
 %%% Saving and restoring a computation
 
-save(A) :- var(A), !,
+save(A) :- save(A,_).
-	'$do_error'(instantiation_error,save(A)).
-save(A) :- atom(A), !, name(A,S), '$save'(S).
-save(S) :- '$save'(S).
 
 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(A) :- atom(A), !, 
-save_program(S) :- '$save_program'(S).
+	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),
+	( atom(A) -> atom_codes(A,S) ; A = S),
-	recorda('$restore_goal',G,R),
+	'$save_program2'(S, G),
-	'$save_program'(S),
-	erase(R),
 	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).