From 10dea13a5122cb1f07bce98f674b4b6574dbd922 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sun, 15 Jan 2012 19:54:06 +0100
Subject: [PATCH] Unicode strings were not properly saved in C compiled code.

---
 src/CHANGELOG       |  2 ++
 src/c/read.d        | 12 ++++++++----
 src/cmp/cmpc-wt.lsp | 19 ++++++++++++++++---
 src/cmp/cmpwt.lsp   |  2 +-
 4 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 2b7fc8962..954585229 100755
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -172,6 +172,8 @@ ECL 11.7.1:
    may be controlled globally using the declaration/proclamation
    EXT:THE-IS-CHECKED.
 
+ - Unicode strings were not properly saved in C compiled code.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***
diff --git a/src/c/read.d b/src/c/read.d
index 0f1473d6a..3c6de48c2 100644
--- a/src/c/read.d
+++ b/src/c/read.d
@@ -2232,10 +2232,14 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
                         memcpy(VV, v->vector.self.t, len * sizeof(cl_object));
                 }
 #else
-		in=ecl_make_string_input_stream
-                        (ecl_make_simple_base_string((char *)block->cblock.data_text,
-                                                     block->cblock.data_text_size),
-                         0, block->cblock.data_text_size);
+		in = ecl_make_simple_base_string((char *)block->cblock.data_text,
+						 block->cblock.data_text_size);
+# ifdef ECL_UNICODE
+		in = si_make_sequence_input_stream(3, in, @':external-format',
+						   @':utf-8');
+# else
+		in=ecl_make_string_input_stream(in, 0, block->cblock.data_text_size);
+# endif
                 progv_list = ECL_SYM_VAL(env, @'si::+ecl-syntax-progv-list+');
                 bds_ndx = ecl_progv(env, ECL_CONS_CAR(progv_list),
                                     ECL_CONS_CDR(progv_list));
diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp
index 4f435a321..47e0bb72c 100644
--- a/src/cmp/cmpc-wt.lsp
+++ b/src/cmp/cmpc-wt.lsp
@@ -124,7 +124,19 @@
 
 (defvar *wt-string-size* 0)
 
-(defun wt-filtered-data (string stream &optional one-liner)
+(defun utf8-encoded-string (string)
+  (let* ((output (make-array (round (* 1.2 (length string)))
+			     :element-type 'base-char
+			     :fill-pointer 0))
+	 (stream (make-sequence-output-stream output :external-format :utf-8)))
+    (write-string string stream)
+    output))
+
+(defun wt-filtered-data (string stream &key one-liner (external-format :default))
+  #+unicode
+  (unless (loop with max = (if (eq external-format :default) 255 127)
+	     for c across string always (<= (char-code c) max))
+    (setf string (utf8-encoded-string string)))
   (let ((N (length string))
 	(wt-data-column 80))
     (incf *wt-string-size* (1+ N)) ; 1+ accounts for a blank space
@@ -152,6 +164,7 @@
     (princ (if one-liner "\""  " \"") stream)
     string))
 
-(defun c-filtered-string (string)
+(defun c-filtered-string (string &key (external-format :utf-8))
   (with-output-to-string (aux-stream)
-    (wt-filtered-data string aux-stream t)))
+    (wt-filtered-data string aux-stream :one-liner t
+		      :external-format external-format)))
diff --git a/src/cmp/cmpwt.lsp b/src/cmp/cmpwt.lsp
index 807bab5a2..cc6ac3756 100644
--- a/src/cmp/cmpwt.lsp
+++ b/src/cmp/cmpwt.lsp
@@ -188,7 +188,7 @@
 
 (defun static-base-string-builder (name value stream)
   (format stream "ecl_def_ct_base_string(~A," name)
-  (wt-filtered-data value stream t)
+  (wt-filtered-data value stream :one-liner t)
   (format stream ",~D,static,const);" (length value)))
 
 (defun static-single-float-builder (name value stream)