From 991bc3ab7827acb0ec932ec90f5edbcbbd311865 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Thu, 9 Feb 2012 23:02:29 +0100
Subject: [PATCH] Changed reader/writer syntax for bytecodes so that shared
 constants remain shared.

---
 src/c/printer/write_code.d | 58 ++++++++++++++++----------------------
 src/c/read.d               | 23 +++++++--------
 2 files changed, 36 insertions(+), 45 deletions(-)

diff --git a/src/c/printer/write_code.d b/src/c/printer/write_code.d
index 631146a7a..281fb44b4 100644
--- a/src/c/printer/write_code.d
+++ b/src/c/printer/write_code.d
@@ -19,37 +19,6 @@
 #include <ecl/internal.h>
 #include <ecl/bytecodes.h>
 
-void
-_ecl_write_bclosure(cl_object x, cl_object stream)
-{
-        if (ecl_print_readably()) {
-                cl_index i;
-                cl_object lex = x->bclosure.lex;
-                cl_object code_l=Cnil, data_l=Cnil;
-                x = x->bclosure.code;
-                for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
-                        code_l = ecl_cons(MAKE_FIXNUM(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
-		data_l = cl_funcall(3, @'concatenate', @'list',
-				    x->bytecodes.data);
-                
-                writestr_stream("#Y", stream);
-                si_write_ugly_object(cl_list(7, x->bytecodes.name, lex,
-                                             Cnil /* x->bytecodes.definition */,
-                                             code_l, data_l,
-                                             x->bytecodes.file,
-                                             x->bytecodes.file_position),
-                                     stream);
-        } else {
-                cl_object name = x->bytecodes.name;
-                writestr_stream("#<bytecompiled-closure ", stream);
-                if (name != Cnil)
-                        si_write_ugly_object(name, stream);
-                else
-                        _ecl_write_addr(x, stream);
-                ecl_write_char('>', stream);
-        }
-}
-
 void
 _ecl_write_bytecodes(cl_object x, cl_object stream)
 {
@@ -59,12 +28,10 @@ _ecl_write_bytecodes(cl_object x, cl_object stream)
                 cl_object code_l=Cnil, data_l=Cnil;
                 for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
                         code_l = ecl_cons(MAKE_FIXNUM(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
-		data_l = cl_funcall(3, @'concatenate', @'list',
-				    x->bytecodes.data);
                 writestr_stream("#Y", stream);
                 si_write_ugly_object(cl_list(7, x->bytecodes.name, lex,
                                              Cnil /* x->bytecodes.definition */,
-                                             code_l, data_l,
+                                             code_l, x->bytecodes.data,
                                              x->bytecodes.file,
                                              x->bytecodes.file_position),
                                      stream);
@@ -78,3 +45,26 @@ _ecl_write_bytecodes(cl_object x, cl_object stream)
                 ecl_write_char('>', stream);
         }
 }
+
+void
+_ecl_write_bclosure(cl_object x, cl_object stream)
+{
+        if (ecl_print_readably()) {
+                cl_object lex = x->bclosure.lex;
+		if (Null(lex)) {
+			_ecl_write_bytecodes(x->bclosure.code, stream);
+		} else {
+			writestr_stream("#Y", stream);
+			si_write_ugly_object(cl_list(2, x->bclosure.code, lex),
+					     stream);
+		}
+        } else {
+                cl_object name = x->bytecodes.name;
+                writestr_stream("#<bytecompiled-closure ", stream);
+                if (name != Cnil)
+                        si_write_ugly_object(name, stream);
+                else
+                        _ecl_write_addr(x, stream);
+                ecl_write_char('>', stream);
+        }
+}
diff --git a/src/c/read.d b/src/c/read.d
index cfe4dbc31..9a2212d4d 100644
--- a/src/c/read.d
+++ b/src/c/read.d
@@ -715,6 +715,16 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
 		FEreader_error("Reader macro #Y should be followed by a list",
 			       in, 0);
         }
+
+	if (ecl_length(x) == 2) {
+		rv = ecl_alloc_object(t_bclosure);
+		rv->bclosure.code = ECL_CONS_CAR(x);
+		x = ECL_CONS_CDR(x);
+		rv->bclosure.lex = ECL_CONS_CAR(x);
+                rv->bclosure.entry = _ecl_bclosure_dispatch_vararg;
+		@(return rv);
+	}
+
         rv = ecl_alloc_object(t_bytecodes);
 
         rv->bytecodes.name = ECL_CONS_CAR(x);
@@ -735,9 +745,8 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
 
         nth = ECL_CONS_CAR(x);
         x = ECL_CONS_CDR(x);
-        rv->bytecodes.data =
-		cl_funcall(4, @'make-array', cl_list_length(nth),
-			   @':initial-contents', nth);
+        rv->bytecodes.data = nth;
+
         if (ECL_ATOM(x)) {
                 nth = Cnil;
         } else {
@@ -754,14 +763,6 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
         rv->bytecodes.file_position = nth;
 
         rv->bytecodes.entry = _ecl_bytecodes_dispatch_vararg;
-
-	if (lex != Cnil) {
-		cl_object x = ecl_alloc_object(t_bclosure);
-		x->bclosure.code = rv;
-		x->bclosure.lex = lex;
-                x->bclosure.entry = _ecl_bclosure_dispatch_vararg;
-		rv = x;
-	}
         @(return rv);
 }