/* Structured output, fast format */ #include "debugger.h"#include "fail.h"#include "gc.h"#include "intext.h"#include "io.h"#include "memory.h"#include "mlvalues.h" struct extern_obj * extern_table;asize_t extern_table_size, extern_table_used; void alloc_extern_table(){  asize_t i;   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;} void resize_extern_table(){  asize_t oldsize;  struct extern_obj * oldtable;  asize_t i, h;   oldsize = extern_table_size;  oldtable = 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;    }    extern_table[h].obj = oldtable[i].obj;    extern_table[h].ofs = oldtable[i].ofs;  }  stat_free((char *) oldtable);} byteoffset_t * extern_block;asize_t extern_size, extern_pos; static void resize_result(){  extern_size = 2 * extern_size;  extern_block = (byteoffset_t *)    stat_resize((char *) extern_block, extern_size * sizeof(byteoffset_t));} static byteoffset_t emit(v)     value v;{  mlsize_t size;  asize_t h;  byteoffset_t res;  value * p;  byteoffset_t * q;  asize_t end_pos;   if (Is_long(v)) return (byteoffset_t) v;  size = Wosize_val(v);  if (size == 0) return (Tag_val(v) << 2) + 2;  if (2 * extern_table_used >= extern_table_size) resize_extern_table();  h = Hash(v);  while (extern_table[h].obj != 0) {    if (extern_table[h].obj == v) return extern_table[h].ofs;    h++;    if (h >= extern_table_size) h = 0;  }  end_pos = extern_pos + 1 + size;  while (end_pos >= extern_size) resize_result();  /* Consistently write the header's color, i.e. gc bits, to the file: */  extern_block[extern_pos++] = Make_header(size, Tag_val(v), Black);  res = extern_pos * sizeof(byteoffset_t);  extern_table[h].obj = v;  extern_table[h].ofs = res;  extern_table_used++;  for (p = &Field(v, 0), q = &extern_block[extern_pos]; size > 0; size--) {    *q++ = *p++;  }  extern_pos = end_pos;  return res;} byteoffset_t emit_all(value root){  asize_t read_pos;  byteoffset_t res;  header_t hd;  mlsize_t sz;  byteoffset_t ofs;   read_pos = extern_pos;  res = emit(root);  while (read_pos < extern_pos) {    hd = (header_t) extern_block[read_pos++];    sz = Wosize_hd(hd);    switch(Tag_hd(hd)) {    case String_tag:    case Double_tag:      read_pos += sz;      break;    case Abstract_tag:    case Final_tag:      invalid_argument("output_value: abstract value");      break;    case Closure_tag:      invalid_argument("output_value: functional value");      break;    default:      while (sz > 0) {        ofs = emit((value) extern_block[read_pos]);        extern_block[read_pos] = ofs;        read_pos++;        sz--;      }      break;    }  }  return res;} value extern_val(chan, v)       /* ML */     struct channel * chan;     value v;{  byteoffset_t res;   extern_size = INITIAL_EXTERN_SIZE;  extern_block =    (byteoffset_t *) stat_alloc(extern_size * sizeof(unsigned long));  extern_pos = 0;  extern_table_size = INITIAL_EXTERN_TABLE_SIZE;  alloc_extern_table();  extern_table_used = 0;  res = emit_all(v);  stat_free((char *) extern_table);  putword(chan, Extern_magic_number);  putword(chan, extern_pos);  if (extern_pos == 0)    putword(chan, res);  else    putblock(chan, (char *) extern_block, extern_pos * sizeof(unsigned long));  stat_free((char *) extern_block);  return Val_unit;}