PL_get_chars: Implement CVT_WRITE and CVT_WRITE_CANONICAL

H/dglobals.h

@@ -141,6 +141,11 @@
 #define Yap_LabelFirstArray WL->label_first_array
 #define Yap_LabelFirstArraySz WL->label_first_array_sz
 
+#define putc_curp WL->putc_curp_
+#define putc_cur_buf WL->putc_cur_buf_
+#define putc_cur_lim WL->putc_cur_lim_
+#define putc_cur_flags WL->putc_cur_flags_
+
 #if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
 #define WORKER WL->worker
 #endif

H/hglobals.h

@@ -143,6 +143,11 @@ typedef struct worker_local {
   Int*  label_first_array;
   UInt  label_first_array_sz;
 
+  char*  putc_curp_;
+  char*  putc_cur_buf_;
+  char*  putc_cur_lim_;
+  UInt  putc_cur_flags_;
+
 #if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
   struct worker  worker;
 #endif

H/iglobals.h

@@ -141,6 +141,11 @@ static void InitWorker(int wid) {
   FOREIGN_WL(wid)->label_first_array = NULL;
   FOREIGN_WL(wid)->label_first_array_sz = 0L;
 
+  FOREIGN_WL(wid)->putc_curp_ = NULL;
+  FOREIGN_WL(wid)->putc_cur_buf_ = NULL;
+  FOREIGN_WL(wid)->putc_cur_lim_ = NULL;
+  FOREIGN_WL(wid)->putc_cur_flags_ = 0L;
+
 #if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
 
 #endif

H/rglobals.h

@@ -141,6 +141,11 @@ static void RestoreWorker(int wid) {
 
 
 
+
+
+
+
+
 #if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
 
 #endif

H/yapio.h

@@ -248,6 +248,7 @@ typedef struct AliasDescS {
 
 /************ SWI compatible support for different encodings ************/
 
+#ifndef SIO_NL_POSIX
 typedef enum {
   ENC_OCTET      = 0,
   ENC_ISO_LATIN1 = 1,
@@ -257,6 +258,7 @@ typedef enum {
   ENC_UNICODE_BE = 16,
   ENC_UNICODE_LE = 32
 } encoding_t;
+#endif
 
 #define MAX_ISO_LATIN1 255
 

include/SWI-Prolog.h

@@ -181,6 +181,7 @@ typedef void *PL_engine_t;
 #define CVT_NUMBER	(CVT_INTEGER|CVT_FLOAT)
 #define CVT_ATOMIC	(CVT_NUMBER|CVT_ATOM|CVT_STRING)
 #define CVT_WRITE	0x0040		/* as of version 3.2.10 */
+#define CVT_WRITE_CANONICAL	0x0080		/* as of version 3.2.10 */
 #define CVT_ALL		(CVT_ATOMIC|CVT_LIST)
 #define CVT_MASK	0x00ff
 

library/yap2swi/yap2swi.c

@@ -33,6 +33,8 @@
 #include	<SWI-Stream.h>
 #include	<SWI-Prolog.h>
 
+#include	<yapio.h>
+
 #ifdef USE_GMP
 #include <gmp.h>
 #endif
@@ -348,18 +350,60 @@ buf_writer(int c)
 #define snprintf(X,Y,Z,A) sprintf(X,Z,A)
 #endif
 
+/* This does not understand UNICODE yet */
+static int do_yap_putc(int sno, wchar_t ch) {
+  if (putc_curp < putc_cur_lim) {
+    *putc_curp++ = ch;
+    return TRUE;
+  } else if (putc_cur_flags & BUF_MALLOC) {
+    /* handle overflow by using realloc(); */
+    UInt bufsize = putc_cur_lim-putc_cur_buf;
+    UInt bufpos = putc_curp-putc_cur_buf;
+
+    if (!(putc_cur_buf = realloc(putc_cur_buf, bufsize+BUF_SIZE))) {
+      /* we can+t go forever */
+      return FALSE;
+    }
+    putc_curp = putc_cur_buf+bufpos;
+    putc_cur_lim = putc_cur_buf+(bufsize+BUF_SIZE);
+    return do_yap_putc(sno, ch);
+  }
+  return FALSE;
+}
 
 X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
 {
   YAP_Term t = Yap_GetFromSlot(l);
   char *tmp;
 
-  if (!(flags & BUF_RING)) {
+  if ((flags & BUF_RING)) {
     tmp = alloc_ring_buf();
+  } else if ((flags & BUF_MALLOC)) {
+    tmp = malloc(BUF_SIZE);
   } else {
     tmp = buffers;
   }
   *sp = tmp;
+  if (flags & (CVT_WRITE|CVT_WRITE_CANONICAL)) {
+    Int write_flags;
+
+    putc_cur_buf = putc_curp = tmp;
+    putc_cur_flags = flags;
+    if (flags & CVT_WRITE_CANONICAL) {
+      write_flags = (Quote_illegal_f|Ignore_ops_f);
+    } else {
+      write_flags = 0;
+    }
+    if ((flags & BUF_RING)) {
+      putc_cur_lim = tmp+(TMP_BUF_SIZE-1);
+    } else {
+      putc_cur_lim = tmp+(BUF_SIZE-1);
+    }
+    Yap_plwrite(t, do_yap_putc, write_flags, 1200);
+    /* may have changed due to overflows */
+    *sp = putc_cur_buf;
+    return TRUE;
+  }
   if (IsAtomTerm(t)) {
     Atom at = AtomOfTerm(t);
     if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_ALL)))

misc/GLOBALS

@@ -153,6 +153,12 @@ UInt				cmem_first_block_sz	Yap_CMemFirstBlockSz	=0L
 Int*				label_first_array	Yap_LabelFirstArray	=NULL
 UInt				label_first_array_sz	Yap_LabelFirstArraySz	=0L
 
+// Thread Local Area for SWI-Prolog emulation routines.
+char*				putc_curp_		putc_curp		=NULL
+char*				putc_cur_buf_		putc_cur_buf		=NULL
+char*				putc_cur_lim_		putc_cur_lim		=NULL
+UInt				putc_cur_flags_		putc_cur_flags		=0L
+
 // Ricardo's stuff
 #if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
 struct worker			worker			WORKER		void