cmake & text support

library/dialect/swi/CMakeLists.txt

@@ -8,4 +8,3 @@ set (SDIALECTS_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"
 };
 
-
+int
-PL_EXPORT(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;
+  type->next = (PL_blob_t *)BlobTypes;
-  SWI_BlobTypes = type;
+  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.c

@@ -1,4 +1,4 @@
-/* yap2swi.c  */
+/* xsswi.c  */
 /*
 * Project: jpl for Yap Prolog
 * Author: Steve Moyle and Vitor Santos Costa
@@ -27,12 +27,16 @@
 #include	<wchar.h>
 #include	<assert.h>
 
-
 #include	<Yap.h>
 #include	<Yatom.h>
-#include	<YapHeap.h>
 #include	<eval.h>
 
+#include	<YapHeap.h>
+#include	<yapio.h>
+#include	<YapText.h>
+#include	<pl-utf8.h>
+
+#include "swi.h"
 #if HAVE_MATH_H
 #include	<math.h>
 #endif
@@ -49,10 +53,6 @@
 
 #define PL_KERNEL 1
 
-#include	<pl-shared.h>
-
-#include	<yapio.h>
-#include	<YapText.h>
 
 #ifdef USE_GMP
 #include <gmp.h>
@@ -63,9 +63,7 @@
 #include <fcntl.h>
 #endif
 
-#include "swi.h"
+//#include "pl-error.h"
-
-#include "pl-error.h"
 
 extern int		PL_unify_termv(term_t l, va_list args);
 
@@ -147,7 +145,7 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
 *  */
 
 
-/* SWI: void PL_agc_hook(void) */
+/*  void PL_agc_hook(void) */
 /** @brief Atom garbage collection hook
 *
 */
@@ -157,6 +155,257 @@ PL_agc_hook(PL_agc_hook_t entry)
   return (PL_agc_hook_t)YAP_AGCRegisterHook((YAP_agc_hook)entry);
 }
 
+/*  void PL_get_nchars(term_t ref, size_t *length, char **output, unsigned flags) */
+/** @brief extract a text representing the term _ref_. A pointer to a string with the text will
+* be output to *_s_, and the size of the string will be written to *_length_,
+* if _length_ is not null.
+*
+* The following flags are recognised (as in the SWI manual )
+*   *CVT_ATOM* Convert if term is an atom.
+*   *CVT_STRING* Convert if term is a string.
+*   *CVT_LIST* Convert if term is a list of of character codes.
+*   *CVT_INTEGER* Convert if term is an integer.
+*   *CVT_FLOAT* Convert if term is a float. The characters returned are the same as write/1 would write for the floating point number.
+*   *CVT_NUMBER* Convert if term is an integer or float.
+*   *CVT_ATOMIC* Convert if term is atomic.
+*   *CVT_VARIABLE* Convert variable to print-name
+*   *CVT_WRITE* Convert any term that is not converted by any of the other flags using write/1. * If no BUF_* is provided, BUF_RING is implied.
+*   *CVT_WRITE_CANONICAL* As CVT_WRITE, but using write_canonical/2.
+*   *CVT_WRITEQ* As CVT_WRITE, but using writeq/2.
+*   *CVT_ALL* Convert if term is any of the above, except for CVT_VARIABLE and CVT_WRITE*.
+*
+*   *CVT_EXCEPTION* If conversion fails due to a type error, raise a Prolog type error exception in addition to failure
+*   *BUF_DISCARDABLE* Data must copied immediately
+*   *BUF_RING* Data is stored in a ring of buffers, currenty implemented as BUF_DISCARDABLE
+*   *BUF_MALLOC* Data is copied to a new buffer returned by PL_malloc(3). When no longer needed the user must call PL_free() on the data.
+*
+*   *REP_ISO_LATIN_1
+Text is in ISO Latin-1 encoding and the call fails if text cannot be represented. This flag has the value 0 and is thus the default.
+*   *REP_UTF8* Convert the text to a UTF-8 string. This works for all text.
+*   *REP_MB* Convert the text using the current locale
+*/
+X_API int
+PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags)
+{ CACHE_REGS
+  seq_tv_t inp;
+  size_t leng;
+  encoding_t enc;
+  int minimal;
+  void *buf;
+  char b[1024];
+
+  buf = b;
+  inp.val.t = Yap_GetFromSlot( l );
+  inp.type = 0;
+  if (flags & CVT_ATOM) {
+    inp.type |= YAP_STRING_ATOM;
+  }
+  if (flags & CVT_ATOM) {
+    inp.type |= YAP_STRING_STRING;
+  }
+  if (flags & CVT_LIST) {
+    inp.type |= YAP_STRING_CODES;
+  }
+  if (flags & CVT_INTEGER) {
+    inp.type |= YAP_STRING_INT|YAP_STRING_BIG;
+  }
+  if (flags & CVT_FLOAT) {
+    inp.type |= YAP_STRING_FLOAT;
+  }
+  if (flags & CVT_VARIABLE) {
+    inp.type |= YAP_STRING_TERM;
+  }
+  if (flags & CVT_WRITE) {
+    inp.type |= YAP_STRING_TERM;
+  }
+  if (flags & CVT_WRITEQ) {
+    inp.type |= YAP_STRING_TERM|YAP_STRING_WQ;
+  }
+  if (flags & CVT_WRITE_CANONICAL) {
+    inp.type |= YAP_STRING_TERM|YAP_STRING_WC;
+  }
+  if (flags & (BUF_DISCARDABLE|BUF_RING)) {
+    inp.val.c = LOCAL_FileNameBuf;
+    leng = YAP_FILENAME_MAX-1;
+  }
+  if (flags & BUF_MALLOC) {
+    inp.val.c = PL_malloc(1024);
+    leng = 1023;
+  }
+  if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) )
+  return false;
+
+  if (enc == ENC_ISO_UTF8) {
+    if (flags & REP_UTF8) {
+      *s = buf;
+      *lengthp = leng;
+      return true;
+    } else if  (flags & REP_ISO_LATIN_1) {
+      char *nptr = buf;
+      const char *optr = buf;
+      int chr;
+      while ((optr = _PL__utf8_get_char(optr, &chr))) {
+        if (chr > 255) {
+          if (flags & BUF_MALLOC) {
+            return false;
+          }
+        }
+        *nptr++ = chr;
+      }
+      *nptr = '\0';
+      *s = buf;
+      *lengthp = leng;
+    } else /* wide */ {
+      size_t sz = utf8_strlen1(buf)+1;
+      const char *optr = buf;
+      wchar_t *nptr, *n = buf;
+      int chr;
+      if (sz <= 1024)
+      n = nptr = (wchar_t *)malloc(sz);
+      while ((optr = _PL__utf8_get_char(optr, &chr))) {
+        *nptr++ = chr;
+      }
+      *nptr = '\0';
+      *s = buf;
+      *lengthp = leng;
+
+      // handle encodings ltaer
+    }
+  }
+  return false;
+}
+
+
+int
+PL_get_chars(term_t t, char **s, unsigned flags)
+{ return PL_get_nchars(t, NULL, s, flags);
+}
+
+int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags)
+{
+  CACHE_REGS
+  seq_tv_t inp;
+  size_t leng;
+  encoding_t enc;
+  int minimal;
+  void *buf;
+  char b[1024];
+
+  buf = b;
+  inp.val.t = Yap_GetFromSlot( l );
+  inp.type = 0;
+  if (flags & CVT_ATOM) {
+    inp.type |= YAP_STRING_ATOM;
+  }
+  if (flags & CVT_ATOM) {
+    inp.type |= YAP_STRING_STRING;
+  }
+  if (flags & CVT_LIST) {
+    inp.type |= YAP_STRING_CODES;
+  }
+  if (flags & CVT_INTEGER) {
+    inp.type |= YAP_STRING_INT|YAP_STRING_BIG;
+  }
+  if (flags & CVT_FLOAT) {
+    inp.type |= YAP_STRING_FLOAT;
+  }
+  if (flags & CVT_VARIABLE) {
+    inp.type |= YAP_STRING_TERM;
+  }
+  if (flags & CVT_WRITE) {
+    inp.type |= YAP_STRING_TERM;
+  }
+  if (flags & CVT_WRITEQ) {
+    inp.type |= YAP_STRING_TERM|YAP_STRING_WQ;
+  }
+  if (flags & CVT_WRITE_CANONICAL) {
+    inp.type |= YAP_STRING_TERM|YAP_STRING_WC;
+  }
+  if (flags & (BUF_DISCARDABLE|BUF_RING)) {
+    inp.val.c = LOCAL_FileNameBuf;
+    leng = YAP_FILENAME_MAX-1;
+  }
+  if (flags & BUF_MALLOC) {
+    inp.val.w = PL_malloc(1024*SIZEOF_WCHAR_T);
+    leng = 1023;
+  }
+  if (!Yap_readText( buf , &inp, & enc, &minimal, & leng PASS_REGS) )
+  return false;
+
+  if (enc == ENC_ISO_UTF8) {
+    if (flags & REP_UTF8) {
+      *s = buf;
+      *lengthp = leng;
+      return true;
+    } else if  (flags & REP_ISO_LATIN_1) {
+      char *nptr = buf;
+      const char *optr = buf;
+      int chr;
+      while ((optr = _PL__utf8_get_char(optr, &chr))) {
+        if (chr > 255) {
+          if (flags & BUF_MALLOC) {
+            return false;
+          }
+        }
+        *nptr++ = chr;
+      }
+      *nptr = '\0';
+      *s = buf;
+      *lengthp = leng;
+    } else /* wide */ {
+      size_t sz = utf8_strlen1(buf)+1;
+      const char *optr = buf;
+      wchar_t *nptr, *n = buf;
+      int chr;
+      if (sz <= 1024)
+      n = nptr = (wchar_t *)malloc(sz*SIZEOF_WCHAR_T);
+      while ((optr = _PL__utf8_get_char(optr, &chr))) {
+        *nptr++ = chr;
+      }
+      *nptr = '\0';
+      *s = buf;
+      *lengthp = leng;
+
+      // handle encodings later
+    }
+  }
+  return false;
+}
+
+X_API int
+PL_unify_chars(term_t l, int flags, size_t length, const char *s)
+{ CACHE_REGS
+  seq_tv_t inp, out;
+
+  if (flags & REP_UTF8) {
+    inp.val.c = s;
+    if (length != (size_t)-1) {
+      inp.sz = length;
+      inp.type = YAP_STRING_CHARS|YAP_STRING_NCHARS;
+    } else {
+      inp.type = YAP_STRING_CHARS;
+    }
+  }
+  if (flags & PL_ATOM) {
+    out.type = YAP_STRING_ATOM;
+  } else if (flags & PL_STRING) {
+    out.type  = YAP_STRING_STRING;
+  } else if (flags & PL_CODE_LIST) {
+    out.type  = YAP_STRING_CODES;
+  } else if (flags & PL_CHAR_LIST) {
+    out.type  = YAP_STRING_ATOMS;
+  }
+  if (length != (size_t)-1) {
+    out.max = length;
+  }
+  if (!Yap_CVT_Text(&inp, &out PASS_REGS))
+  return 0L;
+  return out.val.t;
+}
+
+
+
+
 /** @brief extract the text representation from atom
 *
 */
@@ -186,6 +435,17 @@ X_API char* PL_atom_nchars(atom_t a, size_t *len)	 /* SAM check type */
 *  @ingroup swi-c-interface
 *  */
 
+/** @brief create a clean term reference
+*
+*/
+X_API term_t PL_new_term_ref(void)
+{
+  CACHE_REGS
+  term_t to = Yap_NewSlots(1);
+  return to;
+}
+
+
 /** @brief duplicate a term reference
 *
 */
@@ -195,16 +455,6 @@ X_API term_t PL_copy_term_ref(term_t from)
   return Yap_InitSlot(Yap_GetFromSlot(from));
 }
 
-/** @brief create a new term reference
- *
- */
-X_API term_t PL_new_term_ref(void)
-{
-
-  CACHE_REGS
-  term_t to = Yap_NewSlots(1);
-  return to;
-}
 
 /** @brief create several new term references
 *
@@ -347,7 +597,7 @@ X_API int PL_get_atom(term_t ts, atom_t *a)
 /** @brief *i is assigned the int in term  ts, or the operation fails
 *
 */
-/* SWI: int PL_get_integer(term_t t, int *i)
+/*  int PL_get_integer(term_t t, int *i)
 YAP: long int  YAP_IntOfTerm(Term) */
 X_API int PL_get_integer(term_t ts, int *i)
 {
@@ -380,7 +630,7 @@ X_API int PL_get_long(term_t ts, long *i)
   return 1;
 }
 
-/* SWI: int PL_get_bool(term_t t, int *i)
+/*  int PL_get_bool(term_t t, int *i)
 YAP: long int  YAP_AtomOfTerm(Term) */
 X_API int PL_get_bool(term_t ts, int *i)
 {
@@ -452,6 +702,11 @@ X_API int PL_get_int64(term_t ts, int64_t *i)
   return 1;
 }
 
+X_API int PL_get_int64_ex(term_t ts, int64_t *i)
+{
+  return PL_get_int64( ts,i);
+}
+
 /** @brief *a is assigned the intptr_t in term  ts, or the operation fails
 *
 */
@@ -477,7 +732,7 @@ X_API int PL_get_uintptr(term_t ts, uintptr_t *a)
   *a = (uintptr_t)(IntegerOfTerm(t));
   return 1;
 }
-
+#ifdef do_not_ld
 /** @brief a is assigned the argument index from term  ts
 *
 */
@@ -500,7 +755,7 @@ X_API int _PL_get_arg(int index, term_t ts, term_t a)
   Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
   return 1;
 }
-
+#endif
 
 /** @brief *a is assigned the string representation of the atom in term  ts, or the operation fails
 *
@@ -709,7 +964,7 @@ X_API int PL_unify_mpq(term_t t, mpq_t mpq)
 
 #endif
 
-/* SWI: int PL_get_module(term_t t, module_t *m) */
+/*  int PL_get_module(term_t t, module_t *m) */
 X_API int PL_get_module(term_t ts, module_t *m)
 {
   CACHE_REGS
@@ -720,7 +975,7 @@ X_API int PL_get_module(term_t ts, module_t *m)
   return TRUE;
 }
 
-/* SWI: int PL_new_module(term_t t, module_t *m) */
+/*  int PL_new_module(term_t t, module_t *m) */
 X_API module_t PL_new_module(atom_t swiat)
 {
   Atom at = SWIAtomToAtom(swiat);
@@ -732,7 +987,7 @@ X_API module_t PL_new_module(atom_t swiat)
   return Yap_GetModuleEntry(t);
 }
 
-/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
+/*  int PL_get_atom(term_t t, YAP_Atom *a)
 YAP: YAP_Atom YAP_AtomOfTerm(Term) */
 X_API int PL_get_nil(term_t ts)
 {
@@ -741,7 +996,7 @@ X_API int PL_get_nil(term_t ts)
   return ( t == TermNil );
 }
 
-/* SWI: int PL_get_pointer(term_t t, int *i)
+/*  int PL_get_pointer(term_t t, int *i)
 YAP: NO EQUIVALENT */
 /* SAM TO DO */
 X_API int PL_get_pointer(term_t ts, void **i)
@@ -769,7 +1024,7 @@ X_API int PL_get_tail(term_t ts, term_t tl)
 
 /* begin PL_new_* functions =============================*/
 
-/* SWI: atom_t PL_new_atom(const char *)
+/*  atom_t PL_new_atom(const char *)
 YAP: YAP_Atom LookupAtom(char *) */
 /*  SAM should the following be used instead?
 YAP_Atom  FullLookupAtom(char *)
@@ -1077,7 +1332,7 @@ X_API void PL_put_nil(term_t t)
   Yap_PutInSlot(t,TermNil PASS_REGS);
 }
 
-/* SWI: void PL_put_pointer(term_t -t, void *ptr)
+/*  void PL_put_pointer(term_t -t, void *ptr)
 YAP: NO EQUIVALENT */
 /* SAM TO DO */
 X_API int PL_put_pointer(term_t t, void *ptr)
@@ -1116,7 +1371,7 @@ X_API int PL_put_variable(term_t t)
 
 /* end PL_put_* functions =============================*/
 
-/* SWI: int PL_raise_exception(term_t exception)
+/*  int PL_raise_exception(term_t exception)
 YAP: NO EQUIVALENT */
 /* SAM TO DO */
 
@@ -1161,7 +1416,7 @@ X_API int PL_unify(term_t t1, term_t t2)
   return Yap_unify(Yap_GetFromSlot(t1 ),Yap_GetFromSlot(t2 ));
 }
 
-/* SWI: int PL_unify_atom(term_t ?t, atom  *at)
+/*  int PL_unify_atom(term_t ?t, atom  *at)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_atom(term_t t, atom_t at)
 {
@@ -1170,7 +1425,7 @@ X_API int PL_unify_atom(term_t t, atom_t at)
   return YAP_Unify(Yap_GetFromSlot(t),cterm);
 }
 
-/* SWI: int PL_unify_atom_chars(term_t ?t, const char *chars)
+/*  int PL_unify_atom_chars(term_t ?t, const char *chars)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_atom_chars(term_t t, const char *s)
 {
@@ -1184,7 +1439,7 @@ X_API int PL_unify_atom_chars(term_t t, const char *s)
   return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(at));
 }
 
-/* SWI: int PL_unify_atom_chars(term_t ?t, const char *chars)
+/*  int PL_unify_atom_chars(term_t ?t, const char *chars)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s)
 {
@@ -1198,7 +1453,7 @@ X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s)
   return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(at));
 }
 
-/* SWI: int PL_unify_float(term_t ?t, double f)
+/*  int PL_unify_float(term_t ?t, double f)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_float(term_t t, double f)
 {
@@ -1207,7 +1462,7 @@ X_API int PL_unify_float(term_t t, double f)
   return Yap_unify(Yap_GetFromSlot(t),fterm);
 }
 
-/* SWI: int PL_unify_integer(term_t ?t, long n)
+/*  int PL_unify_integer(term_t ?t, long n)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_integer(term_t t, long n)
 {
@@ -1230,7 +1485,7 @@ X_API int PL_unify_uintptr(term_t t, uintptr_t n)
   return Yap_unify(Yap_GetFromSlot(t),iterm);
 }
 
-/* SWI: int PL_unify_integer(term_t ?t, long n)
+/*  int PL_unify_integer(term_t ?t, long n)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_functor(term_t t, functor_t f)
 {
@@ -1252,7 +1507,7 @@ X_API int PL_unify_functor(term_t t, functor_t f)
   return ff == FunctorOfTerm(tt);
 }
 
-/* SWI: int PL_unify_integer(term_t ?t, long n)
+/*  int PL_unify_integer(term_t ?t, long n)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_int64(term_t t, int64_t n)
 {
@@ -1291,7 +1546,7 @@ X_API int PL_unify_int64(term_t t, int64_t n)
 
 }
 
-/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
+/*  int PL_unify_list(term_t ?t, term_t +h, term_t -t)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
 {
@@ -1316,7 +1571,7 @@ X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
   return TRUE;
 }
 
-/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
+/*  int PL_unify_list(term_t ?t, term_t +h, term_t -t)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_arg(int index, term_t tt, term_t arg)
 {
@@ -1344,7 +1599,7 @@ X_API int PL_unify_arg(int index, term_t tt, term_t arg)
   return Yap_unify(Yap_GetFromSlot(arg),to);
 }
 
-/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
+/*  int PL_unify_list(term_t ?t, term_t +h, term_t -t)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_list_chars(term_t t, const char *chars)
 {
@@ -1357,7 +1612,7 @@ X_API int PL_unify_list_chars(term_t t, const char *chars)
   return Yap_unify(Yap_GetFromSlot(t), chterm);
 }
 
-/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
+/*  int PL_unify_list(term_t ?t, term_t +h, term_t -t)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_list_ncodes(term_t t, size_t len, const char *chars)
 {
@@ -1382,7 +1637,7 @@ PL_unify_list_codes(term_t t, const char *chars)
   return Yap_unify(Yap_GetFromSlot(t), chterm);
 }
 
-/* SWI: int PL_unify_nil(term_t ?l)
+/*  int PL_unify_nil(term_t ?l)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_nil(term_t t)
 {
@@ -1390,7 +1645,7 @@ X_API int PL_unify_nil(term_t t)
   return Yap_unify(Yap_GetFromSlot(t), TermNil);
 }
 
-/* SWI: int PL_unify_pointer(term_t ?t, void *ptr)
+/*  int PL_unify_pointer(term_t ?t, void *ptr)
 YAP: NO EQUIVALENT */
 /* SAM TO DO */
 X_API int PL_unify_pointer(term_t t, void *ptr)
@@ -1400,7 +1655,7 @@ X_API int PL_unify_pointer(term_t t, void *ptr)
   return YAP_Unify(Yap_GetFromSlot(t ), ptrterm);
 }
 
-/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
+/*  int PL_unify_list(term_t ?t, term_t +h, term_t -t)
 YAP long int  unify(YAP_Term* a, Term* b) */
 X_API int PL_unify_string_chars(term_t t, const char *chars)
 {
@@ -1424,7 +1679,7 @@ X_API int PL_unify_string_nchars(term_t t, size_t len, const char *chars)
   return Yap_unify(Yap_GetFromSlot(t), chterm);
 }
 
-/* SWI: int PL_unify_wchars(term_t ?t, int type, size_t len,, const pl_wchar_t *s)
+/*  int PL_unify_wchars(term_t ?t, int type, size_t len,, const pl_wchar_t *s)
 */
 X_API int PL_unify_wchars(term_t t, int type, size_t len, const pl_wchar_t *chars)
 {
@@ -1510,7 +1765,7 @@ typedef struct {
   CELL *ptr;
 } stack_el;
 
-/* SWI: int PL_unify_term(term_t ?t1, term_t ?t2)
+/*  int PL_unify_term(term_t ?t1, term_t ?t2)
 YAP long int  YAP_Unify(YAP_Term* a, Term* b) */
 int PL_unify_termv(term_t l, va_list ap)
 {
@@ -1775,13 +2030,13 @@ PL_unify_term(term_t t, ...)
 
 /* end PL_unify_* functions =============================*/
 
-/* SWI: void PL_register_atom(atom_t atom) */
+/*  void PL_register_atom(atom_t atom) */
 X_API void PL_register_atom(atom_t atom)
 {
   Yap_AtomIncreaseHold(SWIAtomToAtom(atom));
 }
 
-/* SWI: void PL_unregister_atom(atom_t atom) */
+/*  void PL_unregister_atom(atom_t atom) */
 X_API void PL_unregister_atom(atom_t atom)
 {
   Yap_AtomDecreaseHold(SWIAtomToAtom(atom));
@@ -2591,12 +2846,14 @@ alertThread(int tid)
   #endif
 }
 
+#endif
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 PL_thread_raise() is used  for  re-routing   interrupts  in  the Windows
 version, where the signal handler is running  from a different thread as
 Prolog.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+#if 0
 int
 PL_thread_raise(int tid, int sig)
 {
@@ -2610,10 +2867,6 @@ PL_thread_raise(int tid, int sig)
   goto error;
 
 
-  if ( !raiseSignal(REMOTE_PL_local_data_p(tid), sig) ||
-       !alertThread(tid) )
-    goto error;
-
   PL_UNLOCK(L_THREAD);
 
   return TRUE;
@@ -2623,7 +2876,9 @@ PL_thread_raise(int tid, int sig)
 int
 PL_thread_raise(int tid, int sig)
 {
+  #if 0
   if ( !raiseSignal(NULL, sig) )
+  #endif
   return FALSE;
 
   return TRUE;
@@ -2832,7 +3087,7 @@ PL_eval_expression_to_int64_ex(term_t t, int64_t *val)
 
     YAP_BigNumOfTerm(t, (void *)&g);
     if (mpz_sizeinbase(&g,2) > 64) {
-      return PL_error(NULL,0,NULL, ERR_EVALUATION, AtomToSWIAtom(Yap_LookupAtom("int_overflow")));
+      Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, Yap_GetFromSlot(t), "integer_overflow");
     }
     mpz_get_str (s, 10, &g);
     #ifdef _WIN32
@@ -2843,7 +3098,7 @@ PL_eval_expression_to_int64_ex(term_t t, int64_t *val)
     return 1;
     #endif
   }
-  PL_error(NULL,0,NULL, ERR_TYPE, AtomToSWIAtom(Yap_LookupAtom("integer_expression")));
+  Yap_Error(TYPE_ERROR_ATOM, Yap_GetFromSlot(t), "integer_expression");
   return FALSE;
 }
 
@@ -2899,23 +3154,27 @@ PL_foreign_context_address(control_t ctx)
 X_API int
 PL_get_signum_ex(term_t sig, int *n)
 {
+  CACHE_REGS
   char *s;
   int i = -1;
 
   if ( PL_get_integer(sig, &i) )
   {
-  } else if ( PL_get_chars(sig, &s, CVT_ATOM) )
+  } else if ( IsAtomTerm(Yap_GetFromSlot(sig) ) )
-  { i = Yap_signal_index(s);
+  { s = RepAtom(AtomOfTerm(Yap_GetFromSlot(sig)))->StrOfAE;
-  } else
+    i = Yap_signal_index(s);
-  { return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_signal, sig);
+  }
+  else
+  { Yap_Error(TYPE_ERROR_ATOM, Yap_GetFromSlot(sig), "signal handling");
+  return FALSE;
 }
 
 if ( i > 0 && i < 32 )		/* where to get these? */
 { *n = i;
   return TRUE;
 }
-
+Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, Yap_GetFromSlot(sig) , "signal handling");
-  return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_signal, sig);
+return FALSE;
 }
 
 typedef struct blob {
@@ -2985,28 +3244,18 @@ str_prefix(const char *p0, char *s)
 static int
 atom_generator(const char *prefix, char **hit, int state)
 {
+    CACHE_REGS
   struct scan_atoms *index;
   Atom            catom;
   Int            i;
 
-#ifdef O_PLMT
-  if ( !atomgen_key ) {
-    pthread_key_create(&atomgen_key, NULL);
-    state = FALSE;
-  }
-#endif
-
   if ( !state )
   { index = (struct scan_atoms *)malloc(sizeof(struct scan_atoms));
     i = 0;
     catom = NIL;
   } else
   {
-#ifdef O_PLMT
-    index = (struct scan_atoms *)pthread_getspecific(atomgen_key);
-#else
     index = LOCAL_search_atoms;
-#endif
     catom = index->atom;
     i = index->pos;
   }
@@ -3026,13 +3275,10 @@ atom_generator(const char *prefix, char **hit, int state)
       ap = RepAtom(catom);
       READ_LOCK(ap->ARWLock);
       if ( str_prefix(prefix, ap->StrOfAE) ) {
+          CACHE_REGS
         index->pos = i;
         index->atom = ap->NextOfAE;
-#ifdef O_PLMT
-	pthread_setspecific(atomgen_key,index);
-#else
         LOCAL_search_atoms = index;
-#endif
         *hit = ap->StrOfAE;
         READ_UNLOCK(ap->ARWLock);
         return TRUE;
@@ -3041,11 +3287,7 @@ atom_generator(const char *prefix, char **hit, int state)
       READ_UNLOCK(ap->ARWLock);
     }
   }
-#ifdef O_PLMT
-  pthread_setspecific(atomgen_key,NULL);
-#else
   LOCAL_search_atoms = NULL;
-#endif
   free(index);
   return FALSE;
 }
@@ -3097,51 +3339,6 @@ Yap_swi_install(void)
 }
 
 
-extern atom_t 		fileNameStream(IOSTREAM *s);
-extern Atom 		Yap_FileName(IOSTREAM *s);
-
-Atom
-Yap_FileName(IOSTREAM *s)
-{
-  atom_t a = fileNameStream(s);
-  if (!a) {
-    return AtomEmptyAtom;
-  }
-  return SWIAtomToAtom(a);
-}
-
-extern void closeFiles(int);
-
-void
-Yap_CloseStreams(int loud)
-{
-  closeFiles(FALSE);
-}
-
-Int Yap_StreamToFileNo(Term t) {
-  CACHE_REGS
-  IOSTREAM *s;
-  int rc;
-
-  if ( (rc=PL_get_stream_handle(Yap_InitSlot(t), &s)) ) {
-    return Sfileno(s);
-  }
-  return -1;
-}
-
-FILE *Yap_FileDescriptorFromStream(Term t)
-{
-  CACHE_REGS
-  IOSTREAM *s;
-  int rc;
-
-  if ( (rc=PL_get_stream_handle(Yap_InitSlot(t), &s)) ) {
-    fprintf(stderr,"Unimplemented\n");
-    //    return Sfileno(s);
-  }
-  return NULL;
-}
-
 X_API int
 PL_raise(int sig)
 {
@@ -3150,9 +3347,12 @@ PL_raise(int sig)
 }
 
 int
-raiseSignal(PL_local_data_t *ld, int sig)
+raiseSignal(void *ld, int sig);
+
+int
+raiseSignal(void *ld, int sig)
 {
-#if THREADS
+  #if THREADSX
   if (sig == SIG_THREAD_SIGNAL) {
     Yap_signal(YAP_ITI_SIGNAL);
     return TRUE;
@@ -3164,14 +3364,14 @@ raiseSignal(PL_local_data_t *ld, int sig)
 
 
 #if THREADS
-void Yap_LockStream(IOSTREAM *s)
+void Yap_LockStream(void *s)
 {
-  if ( s->mutex ) recursiveMutexLock(s->mutex);
+  //  if ( s->mutex ) recursiveMutexLock(s->mutex);
 }
 
-void Yap_UnLockStream(IOSTREAM *s)
+void Yap_UnLockStream(void *s)
 {
-  if ( s->mutex ) recursiveMutexUnlock(s->mutex);
+  //  if ( s->mutex ) recursiveMutexUnlock(s->mutex);
 }
 #endif
 
@@ -3226,6 +3426,11 @@ term_t Yap_CvtTerm(term_t ts)
   return ts;
 }
 
+char * PL_cwd(char *cwd, size_t cwdlen)
+{
+  return (char *)Yap_getcwd( (const char *)cwd, cwdlen );
+}
+
 /**
 * @}
 * @}

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, []).
-