cmake & text support

library/dialect/swi/CMakeLists.txt

@@ -1,11 +1,10 @@
 set (SDIALECTS_PL
-  INDEX.pl   
-  listing.pl   
-  syspred_options.pl   
+  INDEX.pl
+  listing.pl
+  syspred_options.pl
   )
 
 
 install(FILES ${SDIALECTS_PL}
   DESTINATION ${libpl}/dialect/swi
   )
-  

library/dialect/swi/fli/blobs.c

@@ -23,8 +23,10 @@
  *
  */
 
+#include	<stdio.h>
 #include	<Yap.h>
 #include	<Yatom.h>
+#include	<iopreds.h>
 
 #include <string.h>
 
@@ -32,7 +34,9 @@
 #define _WITH_DPRINTF
 #include <stdio.h>
 
-#include	<pl-shared.h>
+//#include	<SWI-Stream.h>
+//#include	<pl-shared.h>
+
 
 #include "swi.h"
 
@@ -42,8 +46,7 @@ static PL_blob_t unregistered_blob_atom =
   "unregistered"
 };
 
-
-PL_EXPORT(int)
+int
 PL_is_blob(term_t t, PL_blob_t **type)
 {
   CACHE_REGS
@@ -59,76 +62,12 @@ PL_is_blob(term_t t, PL_blob_t **type)
   if (!IsBlob(a))
     return FALSE;
   b = RepBlobProp(a->PropsOfAE);
-  *type = b->blob_t;
+  *type = (struct PL_blob_t *)b->blob_type;
   return TRUE;
 }
 
-
 /* void check_chain(void); */
 
-/* void check_chain(void) { */
-/*   AtomEntry *ae, *old; */
-/*     ae = SWI_Blobs; */
-/*     old = NULL; */
-/*     while (ae) { */
-/*       old = ae; */
-/*       ae = RepAtom(ae->NextOfAE); */
-/*     } */
-/* } */
-
-AtomEntry *
-Yap_lookupBlob(void *blob, size_t len, void *type0, int *new)
-{
-  BlobPropEntry *b;
-  AtomEntry *ae;
-  PL_blob_t *type = type0;
-  if (new)
-    *new = FALSE;
-
-  LOCK(SWI_Blobs_Lock);
-  if (type->flags & PL_BLOB_UNIQUE) {
-    /* just keep a linked chain for now */
-    ae = SWI_Blobs;
-    while (ae) {
-      if (ae->PropsOfAE &&
-	  RepBlobProp(ae->PropsOfAE)->blob_t == type &&
-	  ae->rep.blob->length == len &&
-	  !memcmp(ae->rep.blob->data, blob, len)) {
-	UNLOCK(SWI_Blobs_Lock);
-	return ae;
-      }
-      ae = RepAtom(ae->NextOfAE);
-    }
-  }
-  if (new)
-    *new = TRUE;
-  b = (BlobPropEntry *)Yap_AllocCodeSpace(sizeof(BlobPropEntry));
-  if (!b) {
-    UNLOCK(SWI_Blobs_Lock);
-    return NULL;
-  }
-  b->NextOfPE = NIL;
-  b->KindOfPE = BlobProperty;
-  b->blob_t = type;
-  ae = (AtomEntry *)Yap_AllocCodeSpace(sizeof(AtomEntry)+len+sizeof(size_t));
-  if (!ae) {
-    UNLOCK(SWI_Blobs_Lock);
-    return NULL;
-  }
-  NOfBlobs++;
-  INIT_RWLOCK(ae->ARWLock);
-  ae->PropsOfAE = AbsBlobProp(b);
-  ae->NextOfAE = AbsAtom(SWI_Blobs);
-  ae->rep.blob->length = len;
-  memcpy(ae->rep.blob->data, blob, len);
-  SWI_Blobs = ae;
-  if (NOfBlobs > NOfBlobsMax) {
-    Yap_signal(YAP_CDOVF_SIGNAL);
-  }
-  UNLOCK(SWI_Blobs_Lock);
-  return ae;
-}
-
 PL_EXPORT(int)
 PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
 {
@@ -185,7 +124,7 @@ PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
     return FALSE;
   ae = RepAtom(a);
   if (type)
-    *type = RepBlobProp(ae->PropsOfAE)->blob_t;
+    *type = (struct PL_blob_t *)RepBlobProp(ae->PropsOfAE)->blob_type;
   if (len)
     *len = ae->rep.blob[0].length;
   if (blob)
@@ -215,7 +154,7 @@ PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
   if ( len )
     *len = x->rep.blob[0].length;
   if ( type )
-    *type = RepBlobProp(x->PropsOfAE)->blob_t;
+    *type = (struct PL_blob_t *)RepBlobProp(x->PropsOfAE)->blob_type;
 
   return x->rep.blob[0].data;
 }
@@ -223,8 +162,8 @@ 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)
 {
-  type->next = SWI_BlobTypes;
-  SWI_BlobTypes = type;
+  type->next = (PL_blob_t *)BlobTypes;
+  BlobTypes = (struct YAP_blob_t *)type;
 }
 
 PL_EXPORT(PL_blob_t*)
@@ -235,16 +174,6 @@ PL_find_blob_type(const char* name)
   return YAP_find_blob_type((YAP_Atom)at);
 }
 
-PL_EXPORT(PL_blob_t*)
-YAP_find_blob_type(YAP_Atom at)
-{
-  AtomEntry *a = RepAtom((Atom)at);
-  if (!IsBlob(a)) {
-    return &unregistered_blob_atom;
-  }
-  return RepBlobProp(a->PropsOfAE)->blob_t;
-}
-
 PL_EXPORT(int)
 PL_unregister_blob_type(PL_blob_t *type)
 {
@@ -252,11 +181,6 @@ PL_unregister_blob_type(PL_blob_t *type)
   return FALSE;
 }
 
-void
-Yap_install_blobs(void)
-{
-
-}
 
 /**
  * @}

library/dialect/swi/fli/swi.h

@@ -34,6 +34,12 @@
  *  from the C programmer.
 
  */
+
+#ifndef SWI_H
+#define SWI_H 1
+
+#include "SWI-Prolog.h"
+
 void Yap_swi_install(void);
 void Yap_install_blobs(void);
 
@@ -75,6 +81,39 @@ SWIModuleToModule(module_t m)
   return USER_MODULE;
 }
 
+
+#ifdef YATOM_H
+
+static inline atom_t
+AtomToSWIAtom(Atom at)
+{
+  TranslationEntry *p;
+
+  if ((p = Yap_GetTranslationProp(at)) != NULL)
+    return (atom_t)(p->Translation*2+1);
+  return (atom_t)at;
+}
+
+#endif
+
+static inline Atom
+SWIAtomToAtom(atom_t at)
+{
+  if ((CELL)at & 1)
+    return SWI_Atoms[at/2];
+  return (Atom)at;
+}
+
+
+/* This is silly, but let's keep it like that for now */
+static inline Functor
+SWIFunctorToFunctor(functor_t f)
+{
+  if (((CELL)(f) & 2) && ((CELL)f) < N_SWI_FUNCTORS*4+2)
+    return SWI_Functors[((CELL)f)/4];
+  return (Functor)f;
+}
+
 static inline functor_t
 FunctorToSWIFunctor(Functor at)
 {
@@ -86,6 +125,9 @@ FunctorToSWIFunctor(Functor at)
 
 #define isDefinedProcedure(pred) TRUE // TBD
 
+int Yap_write_blob(AtomEntry *ref,  FILE *stream);
+#endif
+
 /**
   @}
 */

library/dialect/swi/listing.pl

@@ -2,4 +2,3 @@
 % SWI compatibility only
 
 :- module(listing, []).
-