1 files changed, 168 insertions, 67 deletions

diff --git a/byterun/extern.c b/byterun/extern.c
index 15f709077..3c4404bda 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -13,6 +13,7 @@
 
 /* Structured output */
 
+#include "alloc.h"
 #include "fail.h"
 #include "gc.h"
 #include "intext.h"
@@ -47,14 +48,14 @@ static void alloc_extern_table()
 
   extern_table = (struct extern_obj *)
     stat_alloc(extern_table_size * sizeof(struct extern_obj));
-  for (i = 0; i < extern_table_size; i++)
-    extern_table[i].obj = 0;
+  for (i = 0; i < extern_table_size; i++) extern_table[i].obj = 0;
 }
 
 static void resize_extern_table()
 {
   asize_t oldsize;
   struct extern_obj * oldtable;
+  value obj;
   asize_t i, h;
 
   oldsize = extern_table_size;
@@ -62,94 +63,162 @@ static void resize_extern_table()
   extern_table_size = 2 * extern_table_size;
   alloc_extern_table();
   for (i = 0; i < oldsize; i++) {
-    h = Hash(oldtable[i].obj);
-    while (extern_table[h].obj != 0) {
-      h++;
-      if (h >= extern_table_size) h = 0;
+    obj = oldtable[i].obj;
+    if (obj != 0) {
+      h = Hash(obj);
+      while (extern_table[h].obj != 0) {
+        h++;
+        if (h >= extern_table_size) h = 0;
+      }
+      extern_table[h].obj = obj;
+      extern_table[h].ofs = oldtable[i].ofs;
     }
-    extern_table[h].obj = oldtable[i].obj;
-    extern_table[h].ofs = oldtable[i].ofs;
   }
   stat_free((char *) oldtable);
 }
 
-/* Write integers on a channel */
+/* To buffer the output */
 
-static void output8(chan, code, val)
-     struct channel * chan;
+static char * extern_block, * extern_ptr, * extern_limit;
+
+static void alloc_extern_block()
+{
+  extern_block = stat_alloc(INITIAL_EXTERN_BLOCK_SIZE);
+  extern_limit = extern_block + INITIAL_EXTERN_BLOCK_SIZE;
+  extern_ptr = extern_block;
+}
+
+static void resize_extern_block(required)
+     int required;
+{
+  long curr_pos, size, reqd_size;
+
+  curr_pos = extern_ptr - extern_block;
+  size = extern_limit - extern_block;
+  reqd_size = curr_pos + required;
+  while (size <= reqd_size) size *= 2;
+  extern_block = stat_resize(extern_block, size);
+  extern_limit = extern_block + size;
+  extern_ptr = extern_block + curr_pos;
+}
+
+#define Write(c) \
+  if (extern_ptr >= extern_limit) resize_extern_block(1); \
+  *extern_ptr++ = (c)
+
+/* Write integers and blocks in the output buffer */
+
+static void writeblock(data, len)
+     char * data;
+     long len;
+{
+  if (extern_ptr + len > extern_limit) resize_extern_block(len);
+  bcopy(data, extern_ptr, len);
+  extern_ptr += len;
+}
+
+static void writecode8(code, val)
      int code;
      long val;
 {
-  putch(chan, code); putch(chan, val);
+  if (extern_ptr + 2 > extern_limit) resize_extern_block(2);
+  extern_ptr[0] = code;
+  extern_ptr[1] = val;
+  extern_ptr += 2;
 }
 
-static void output16(chan, code, val)
-     struct channel * chan;
+static void writecode16(code, val)
      int code;
      long val;
 {
-  putch(chan, code); putch(chan, val >> 8); putch(chan, val);
+  if (extern_ptr + 3 > extern_limit) resize_extern_block(3);
+  extern_ptr[0] = code;
+  extern_ptr[1] = val >> 8;
+  extern_ptr[2] = val;
+  extern_ptr += 3;
 }
 
-static void output32(chan, code, val)
-     struct channel * chan;
+static void write32(val)
+     long val;
+{
+  if (extern_ptr + 4 > extern_limit) resize_extern_block(4);
+  extern_ptr[0] = val >> 24;
+  extern_ptr[1] = val >> 16;
+  extern_ptr[2] = val >> 8;
+  extern_ptr[3] = val;
+  extern_ptr += 4;
+}
+
+static void writecode32(code, val)
      int code;
      long val;
 {
-  putch(chan, code);
-  putch(chan, val >> 24); putch(chan, val >> 16);
-  putch(chan, val >> 8); putch(chan, val);
+  if (extern_ptr + 5 > extern_limit) resize_extern_block(5);
+  extern_ptr[0] = code;
+  extern_ptr[1] = val >> 24;
+  extern_ptr[2] = val >> 16;
+  extern_ptr[3] = val >> 8;
+  extern_ptr[4] = val;
+  extern_ptr += 5;
 }
 
 #ifdef SIXTYFOUR
-static void output64(chan, code, val)
-     struct channel * chan;
+static void writecode64(code, val)
      int code;
      long val;
 {
   int i;
-  putch(chan, code);
-  for (i = 64 - 8; i >= 0; i -= 8) putch(chan, val >> i);
+  if (extern_ptr + 9 > extern_limit) resize_extern_block(9);
+  *extern_ptr ++ = code;
+  for (i = 64 - 8; i >= 0; i -= 8) *extern_ptr++ = val >> i;
 }
 #endif
 
+/* Marshal the given value in the output buffer */
+
 static byteoffset_t obj_counter;    /* Number of objects emitted so far */
 static unsigned long size_32;  /* Size in words of 32-bit block for struct. */
 static unsigned long size_64;  /* Size in words of 64-bit block for struct. */
 
-static void emit_compact(chan, v)
-     struct channel * chan;
+static void extern_cleanup()
+{
+  stat_free(extern_block);
+  stat_free((char *) extern_table);
+}
+
+static void extern_rec(v)
      value v;
 {
  tailcall:
   if (Is_long(v)) {
     long n = Long_val(v);
     if (n >= 0 && n < 0x40) {
-      putch(chan, PREFIX_SMALL_INT + n);
+      Write(PREFIX_SMALL_INT + n);
     } else if (n >= -(1 << 7) && n < (1 << 7)) {
-      output8(chan, CODE_INT8, n);
+      writecode8(CODE_INT8, n);
     } else if (n >= -(1 << 15) && n < (1 << 15)) {
-      output16(chan, CODE_INT16, n);
+      writecode16(CODE_INT16, n);
 #ifdef SIXTYFOUR
     } else if (n < -(1L << 31) || n >= (1L << 31)) {
-      output64(chan, CODE_INT64, n);
+      writecode64(CODE_INT64, n);
 #endif
     } else
-      output32(chan, CODE_INT32, n);
+      writecode32(CODE_INT32, n);
   } else if (!Is_atom(v) && !Is_young(v) && !Is_in_heap(v)) {
+    extern_cleanup();
     invalid_argument("output_value: abstract value");
   } else {
     header_t hd = Hd_val(v);
     tag_t tag = Tag_hd(hd);
     mlsize_t sz = Wosize_hd(hd);
-      asize_t h;
+    asize_t h;
     /* Atoms are treated specially for two reasons: they are not allocated
        in the externed block, and they are automatically shared. */
     if (sz == 0) {
       if (tag < 16) {
-        putch(chan, PREFIX_SMALL_BLOCK + tag);
+        Write(PREFIX_SMALL_BLOCK + tag);
       } else {
-        output32(chan, CODE_BLOCK32, hd);
+        writecode32(CODE_BLOCK32, hd);
       }
     } else {
       /* Check if already seen */
@@ -159,11 +228,11 @@ static void emit_compact(chan, v)
         if (extern_table[h].obj == v) {
           byteoffset_t d = obj_counter - extern_table[h].ofs;
           if (d < 0x100) {
-            output8(chan, CODE_SHARED8, d);
+            writecode8(CODE_SHARED8, d);
           } else if (d < 0x10000) {
-            output16(chan, CODE_SHARED16, d);
+            writecode16(CODE_SHARED16, d);
           } else {
-            output32(chan, CODE_SHARED32, d);
+            writecode32(CODE_SHARED32, d);
           }
           return;
         }
@@ -178,59 +247,65 @@ static void emit_compact(chan, v)
       case String_tag: {
         mlsize_t len = string_length(v);
         if (len < 0x20) {
-          putch(chan, PREFIX_SMALL_STRING + len);
+          Write(PREFIX_SMALL_STRING + len);
         } else if (len < 0x100) {
-          output8(chan, CODE_STRING8, len);
+          writecode8(CODE_STRING8, len);
         } else {
-          output32(chan, CODE_STRING32, len);
+          writecode32(CODE_STRING32, len);
         }
-        putblock(chan, String_val(v), len);
+        writeblock(String_val(v), len);
         size_32 += 1 + (len + 4) / 4;
         size_64 += 1 + (len + 8) / 8;
         break;
       }
       case Double_tag: {
-        if (sizeof(double) != 8)
+        if (sizeof(double) != 8) {
+          extern_cleanup();
           invalid_argument("output_value: non-standard floats");
-        putch(chan, CODE_DOUBLE_NATIVE);
-        putblock(chan, (char *) v, 8);
+        }
+        Write(CODE_DOUBLE_NATIVE);
+        writeblock((char *) v, 8);
         size_32 += 1 + 2;
         size_64 += 1 + 1;
         break;
       }
       case Double_array_tag: {
         mlsize_t nfloats;
-        if (sizeof(double) != 8)
+        if (sizeof(double) != 8) {
+          extern_cleanup();
           invalid_argument("output_value: non-standard floats");
+        }
         nfloats = Wosize_val(v) / Double_wosize;
         if (nfloats < 0x100) {
-          output8(chan, CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
+          writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
         } else {
-          output32(chan, CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
+          writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
         }
-        putblock(chan, (char *) v, Bosize_val(v));
+        writeblock((char *) v, Bosize_val(v));
         size_32 += 1 + nfloats * 2;
         size_64 += 1 + nfloats;
         break;
       }
       case Abstract_tag:
       case Final_tag:
+        extern_cleanup();
         invalid_argument("output_value: abstract value");
         break;
       case Closure_tag:
       case Infix_tag:
+        extern_cleanup();
         invalid_argument("output_value: functional value");
         break;
       default: {
         mlsize_t i;
         if (tag < 16 && sz < 8) {
-          putch(chan, PREFIX_SMALL_BLOCK + tag + (sz << 4));
+          Write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
         } else {
-          output32(chan, CODE_BLOCK32, hd);
+          writecode32(CODE_BLOCK32, hd);
         }
         size_32 += 1 + sz;
         size_64 += 1 + sz;
-        for (i = 0; i < sz - 1; i++) emit_compact(chan, Field(v, i));
+        for (i = 0; i < sz - 1; i++) extern_rec(Field(v, i));
         v = Field(v, i);
         goto tailcall;
       }
@@ -239,22 +314,25 @@ static void emit_compact(chan, v)
   }
 }
 
-value output_value(chan, v) /* ML */
-     struct channel * chan;
+static long extern_value(v)
      value v;
 {
-  value start_loc, final_loc;
-  putword(chan, Intext_magic_number);
-  start_loc = pos_out(chan);
-  putword(chan, 0);
-  putword(chan, 0);
-  putword(chan, 0);
+  long res_len;
+  alloc_extern_block();
   extern_table_size = INITIAL_EXTERN_TABLE_SIZE;
   alloc_extern_table();
   obj_counter = 0;
   size_32 = 0;
   size_64 = 0;
-  emit_compact(chan, v);
+  /* Write magic number */
+  write32(Intext_magic_number);
+  /* Set aside space for the sizes */
+  extern_ptr += 4*4;
+  /* Marshal the object */
+  extern_rec(v);
+  /* Free the table of shared objects */
+  stat_free((char *) extern_table);
+  /* Write the sizes */
 #ifdef SIXTYFOUR
   if (size_32 >= (1L << 32) || size_64 >= (1L << 32)) {
     /* The object is so big its size cannot be written in the header.
@@ -263,12 +341,35 @@ value output_value(chan, v) /* ML */
     failwith("output_value: object too big");
   }
 #endif
-  final_loc = pos_out(chan);
-  seek_out(chan, start_loc);
-  putword(chan, obj_counter);
-  putword(chan, size_32);
-  putword(chan, size_64);
-  seek_out(chan, final_loc);
-  stat_free((char *) extern_table);
+  res_len = extern_ptr - extern_block;
+  extern_ptr = extern_block + 4;
+  write32(res_len - 5*4);
+  write32(obj_counter);
+  write32(size_32);
+  write32(size_64);
+  /* Result is res_len bytes starting at extern_block */
+  return res_len;
+}
+
+value output_value(chan, v) /* ML */
+     struct channel * chan;
+     value v;
+{
+  long len;
+  len = extern_value(v);
+  putblock(chan, extern_block, len);
+  stat_free(extern_block);
   return Val_unit;
 }
+
+value output_value_to_string(v) /* ML */
+     value v;
+{
+  long len;
+  value res;
+  len = extern_value(v);
+  res = alloc_string(len);
+  bcopy(extern_block, String_val(res), len);
+  stat_free(extern_block);
+  return res;
+}