From b9b960f178f032b2f2acd66d05b08f5871aad0b5 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Tue, 10 May 2005 08:10:52 +0000
Subject: [PATCH] Bytecode functions can now be printed/read (M. Pasternacki)

---
 src/CHANGELOG |  7 +++++++
 src/c/print.d | 39 +++++++++++++++++++++++++++------------
 src/c/read.d  | 40 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 74 insertions(+), 12 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 090b0b05a..55d0bce4e 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -1,6 +1,10 @@
 ECL 0.9f
 ========
 
+* Platforms:
+
+ - Cygwin support has been fixed and it now supports DLLs (M. Goffioul).
+
 * Errors fixed:
 
  - The reader macros for lists, ##, #C, #P and #' did not behave as expected
@@ -129,6 +133,9 @@ ECL 0.9f
  - ECL now accepts a double dash, '--', as a command line option. Anything
    after the double dash is interpreted as a lisp command.
 
+ - Bytecode functions can now be printed readably as #Y(...). The appropiate
+   reader macro has been also implemented (M. Pasternacki)
+
 * ANSI Compatibility:
 
  - DEFSETF forms are enclosed in a block with the name of the accessor.
diff --git a/src/c/print.d b/src/c/print.d
index 9cf5f41fa..4a3c91e83 100644
--- a/src/c/print.d
+++ b/src/c/print.d
@@ -24,6 +24,7 @@
 #endif
 #include "ecl.h"
 #include "internal.h"
+#include "bytecodes.h"
 
 #if defined(ECL_CMU_FORMAT)
 # define si_write_object_recursive(x,y) si_write_object(x,y)
@@ -1339,18 +1340,32 @@ si_write_ugly_object(cl_object x, cl_object stream)
 		si_write_ugly_object(namestring, stream);
 		break;
 	}
-	case t_bytecodes: {
-		cl_object name = x->bytecodes.name;
-		if (ecl_print_readably()) FEprint_not_readable(x);
-		write_str("#<bytecompiled-function ", stream);
-		if (name != Cnil)
-			si_write_ugly_object(name, stream);
-		else
-			write_addr(x, stream);
-		write_ch('>', stream);
-		break;
-	}
-	case t_cfun:
+	case t_bytecodes:
+                if ( ecl_print_readably() ) {
+	                cl_index i;
+                        cl_object code_l=Cnil, data_l=Cnil;
+                        for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
+                             code_l = make_cons(MAKE_FIXNUM(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
+                        for ( i=x->bytecodes.data_size-1 ; i<(cl_index)(-1l) ; i-- )
+                             data_l = make_cons(x->bytecodes.data[i], data_l);
+
+                        write_str("#Y", stream);
+                        si_write_ugly_object(
+			    cl_list(6, x->bytecodes.name, x->bytecodes.lex,
+				    x->bytecodes.specials, Cnil /* x->bytecodes.definition */,
+				    code_l, data_l),
+			    stream);
+                } else {
+                        cl_object name = x->bytecodes.name;
+                        write_str("#<bytecompiled-function ", stream);
+                        if (name != Cnil)
+                             si_write_ugly_object(name, stream);
+                        else
+                             write_addr(x, stream);
+                        write_ch('>', stream);
+                }
+                break;
+        case t_cfun:
 		if (ecl_print_readably()) FEprint_not_readable(x);
 		write_str("#<compiled-function ", stream);
 		if (x->cfun.name != Cnil)
diff --git a/src/c/read.d b/src/c/read.d
index 201e60f45..d23cf0e50 100644
--- a/src/c/read.d
+++ b/src/c/read.d
@@ -23,6 +23,7 @@
 #include "ecl.h"
 #include "internal.h"
 #include "ecl-inl.h"
+#include "bytecodes.h"
 
 #define	cat(rtbl,c)	((rtbl)->readtable.table[c].syntax_type)
 #define read_suppress (SYM_VAL(@'*read-suppress*') != Cnil)
@@ -718,6 +719,44 @@ sharp_single_quote_reader(cl_object in, cl_object c, cl_object d)
 	@(return c)
 }
 
+static cl_object
+sharp_Y_reader(cl_object in, cl_object c, cl_object d)
+{
+        cl_index i;
+        cl_object x, rv, nth;
+
+	if (d != Cnil && !read_suppress)
+		extra_argument('C', in, d);
+	x = read_object(in);
+	if (x == OBJNULL)
+		FEend_of_file(in);
+	if (read_suppress)
+		@(return Cnil);
+	if (type_of(x) != t_cons || length(x) != 6)
+		FEreader_error("Reader macro #Y should be followed by a list",
+			       in, 0);
+
+        rv = cl_alloc_object(t_bytecodes);
+
+        rv->bytecodes.name = CAR(x); x = CDR(x);
+        rv->bytecodes.lex = CAR(x); x = CDR(x);
+        rv->bytecodes.specials = CAR(x); x = CDR(x);
+        rv->bytecodes.definition = CAR(x); x = CDR(x);
+
+        rv->bytecodes.code_size = fixint(cl_list_length(CAR(x)));
+        rv->bytecodes.code = cl_alloc(rv->bytecodes.code_size * sizeof(uint16_t));
+        for ( i=0, nth=CAR(x) ; !endp(nth) ; i++, nth=CDR(nth) )
+             ((cl_opcode*)(rv->bytecodes.code))[i] = fixint(CAR(nth));
+        x = CDR(x);
+
+        rv->bytecodes.data_size = fixint(cl_list_length(CAR(x)));
+        rv->bytecodes.data = cl_alloc(rv->bytecodes.data_size * sizeof(cl_object));
+        for ( i=0, nth=CAR(x) ; !endp(nth) ; i++, nth=CDR(nth) )
+             ((cl_object*)(rv->bytecodes.data))[i] = CAR(nth);
+
+        @(return rv);
+}
+
 #define	QUOTE	1
 #define	EVAL	2
 #define	LIST	3
@@ -1897,6 +1936,7 @@ init_read(void)
 	= make_cf3(sharp_whitespace_reader);
 	dtab[')'] = make_cf3(sharp_right_parenthesis_reader);
 */
+        dtab['Y'] = dtab['y'] = make_cf3(sharp_Y_reader);
 
 	init_backq();