/* dumpct.c *********************************************************

                         The Anubis Compiler 
                   Dumping constructors in C format. 

********************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include "compil.h"


Expr C_constr_types_list = nil; 

void make_C_constr(Expr lc,
                   Expr file_name, 
     Expr new_name, 
     Expr type)
{
  Expr implem; 

  check_explicit_type(lc,type,nil); 
 
  find_infinite_types(); 
  infinite_flags_reliable = 1; 
  implem = implems[type_implementation_id(type,nil)].implem; 
  infinite_flags_reliable = 0; 

  if (car(implem) == small_type ||
      car(implem) == mixed_type ||
      car(implem) == large_type)
    C_constr_types_list = cons(mcons3(new_name,type,implem),C_constr_types_list);
}

 
static char *regular_string_content(Expr x) 
 { 
  if (x == pdstr_nil)      return "nil";   
  if (x == pdstr_cons)     return "cons"; 
  return string_content(x);  
 } 
 


void dump_C_types(void)
{
  Expr aux; 
  FILE *h_target = fopenz("construc.h.out","wt"); 
  FILE *c_target = fopenz("construc.c.out","wt");

  fprintf(h_target,"/* Generated by the Anubis compiler: constructors in C format.*/\n\n"
          "#include \"AnubisAllocator.h\"\n"
          "using namespace CM;\n\n"
          ); 
  fprintf(c_target,"/* Generated by the Anubis compiler: constructors in C format.*/\n\n"
   "/* If memory cannot be allocated, the functions defined below return 0\n"
   " * which is a regular value for the garbage-collector. They also set\n"
   " * the flag 'dct_error_flag'. Hence, you must test this flag and if it is\n"
   " * set, delete the result.\n"
   " */\n\n"
         ); 

  aux = C_constr_types_list; 

  while (consp(aux))
    {
      /* car(aux) = (name type . implem) */ 
      Expr name = car(car(aux));
      Expr type = second(car(aux)); 
  
      Expr implem = cdr2(car(aux)); 
      char *type_name = string_content(name); 
      Expr alts_implems = cdr3(implem);
   
      int ind = 0;

      Expr alts = get_alts(type,nil,0);      
   
      aux = cdr(aux); 

      if(verbose)
 {
   printf("Dumping constructors in C for '%s' ",type_name); 
 }
   
      fprintf(h_target,"/* constructors for type '"); 
      show_type(h_target,type,nil); 
      fprintf(h_target,"': */\n\n");
      if (dcti)
        {
          fprintf(h_target,"/* "); 
          print_expr(h_target,implem); 
          fprintf(h_target," */\n\n"); 
        }

      switch (car(implem))
 {
 case small_type:
   {
     if (verbose) printf("(small type).\n"); 

     /* implem = (small_type <nalt> <iw> <alt geom> ...) */ 
     /* alts_implems = (<alt geom> ...) */ 
            /* <alt geom> = (small_type (<imp> <offset> . <width>) ...) */ 
            /* alts = ((("name" ...) (type . sym) ...) ...) */ 
     while (consp(alts_implems))
       {
  int k; 
  Expr aux2; 
                Expr alt_name = car(car(car(alts))); 
  Expr geom = cdr(car(alts_implems)); 
  /* geom = ((<imp> <offset> . <width>) ...) */ 

  alts_implems = cdr(alts_implems); 
                alts = cdr(alts); 

  fprintf(h_target,
   "\n#define %s%s",
   type_name,
                        regular_string_content(alt_name));

  if (consp(geom)) fprintf(h_target,"("); 

  k = 1; 
  aux2 = geom; 
  while (consp(aux2))
    {
      fprintf(h_target,"_%d",k++);
      aux2 = cdr(aux2);
      if (consp(aux2)) fprintf(h_target,",");
    }
  if (k >= 2) fprintf(h_target,")"); 
  fprintf(h_target," (%d",ind); 

  k = 1; 
  while(consp(geom))
    {
      fprintf(h_target,"|((_%d)<<%d)",k++,integer_value(second(car(geom))));
      geom = cdr(geom); 
    }
  fprintf(h_target,")\n"); 
  ind++; /* next alternative index */ 
       }
   }
   break; 

 case mixed_type:
 case large_type:
   {
     if (verbose) 
       { 
  if (car(implem) == large_type) 
    printf("(large type).\n"); 
  else 
    printf("(mixed type)).\n"); 
       }

     fprintf(c_target,"/*********** constructors for type '");
            show_type(c_target,type,nil); 
            fprintf(c_target,"' ************/\n\n");
            if (dcti)
              {
                fprintf(c_target,"/* "); 
                print_expr(c_target,implem); 
                fprintf(c_target," */\n\n"); 
              }



     while (consp(alts_implems))
       {
  int k;
  int n, d;
  Expr aux; 
                Expr alt_name = car(car(car(alts))); 
  Expr alt_sort = car(car(alts_implems));
  Expr geom = cdr(car(alts_implems)); 

  alts_implems = cdr(alts_implems); 
                alts = cdr(alts); 

  /* alt_sort may be small_alt or mixed_alt for mixed
     types, and large_alt for large types. */ 

  if (alt_sort == small_alt)
    {
      int k; 
      Expr aux2; 
      /* geom = ((<imp> <offset> . <width>) ...) */ 

      fprintf(h_target,
       "\n#define %s%s",
       type_name,
       regular_string_content(alt_name)); 

      if (consp(geom)) fprintf(h_target,"("); 

      k = 1; 
      aux2 = geom; 
      while (consp(aux2))
        {
   fprintf(h_target,"_%d",k++);
   aux2 = cdr(aux2);
   if (consp(aux2)) fprintf(h_target,",");
        }
      if (k >= 2) fprintf(h_target,")"); 
      fprintf(h_target," (%d",ind); 

      k = 1; 
      while(consp(geom))
        {
   fprintf(h_target,"|((_%d)<<%d)",k++,integer_value(second(car(geom))));
   geom = cdr(geom); 
        }
      fprintf(h_target,")\n"); 

    }
  else /* large or mixed alt */ 
    {
      /* compute the size to allocate */
      aux = geom; 
      n = d = 4; 
      if (car(implem) == large_type) { n++; d++; } 
      while (consp(aux))
        {
   n += integer_value(cdr2(car(aux))); 
   aux = cdr(aux); 
        }

      /* convert n (bytes) into a number of words (4 bytes) */ 
      while (n&3) n++; 
      n >>= 2;       

                    fprintf(h_target,
                            "\n#define %s%s(",
                            type_name,
                            regular_string_content(alt_name)); 
   
      k = 1; 
      aux = geom;
      while (consp(aux))
        {
   fprintf(h_target,"%s_%d",k==1 ? "":",", k); 
   k++; 
   aux = cdr(aux); 
        }
      fprintf(h_target,")\\\n"); 
   
                    fprintf(h_target,
                            "  (_%s%s(allocator",
                            type_name,
                            regular_string_content(alt_name)); 

      k = 1; 
      aux = geom;
      while (consp(aux))
        {
   fprintf(h_target,",_%d", k); 
   k++; 
   aux = cdr(aux); 
        }
      fprintf(h_target,"))\n"); 
   
                fprintf(h_target,
       "\nextern U32 _%s%s(AnubisAllocator * dct_allocator",
       type_name,
       regular_string_content(alt_name));
      fprintf(c_target,
       "\nU32 _%s%s(AnubisAllocator * dct_allocator",
       type_name,
       regular_string_content(alt_name));

      k = 1; 
      aux = geom;
      while (consp(aux))
        {
   fprintf(h_target,",U32 _%d",k); 
   fprintf(c_target,",U32 _%d",k); 
   k++; 
   aux = cdr(aux); 
        }
      fprintf(h_target,"); \n"); 
      fprintf(c_target,")\n"
       "{\n"
       "  U32 result;\n"
       "\n"
       "  /* allocate %d words (= %d bytes) */\n"
       "  if ((result = allocate_data_segment(%d,dct_allocator)) == 0)\n",
       n,4*n,n); 
      fprintf(c_target,
       "    {\n"
       "      if (!enlarge_memory(dct_allocator) ||\n"
                            "          (result = allocate_data_segment(%d,dct_allocator)) == 0)\n"
                            "        { dct_error_flag = 1; return 0; }\n"
       "    }\n",n);  

      if (car(implem) == large_type)
        fprintf(c_target,
         "  *(((U8 *)result)+4) = %d;\n",
         ind); 

      aux = geom; 
      k = 1; 
      while (consp(aux))
        {
   int w =   cdr2(car(aux)) == new_integer(0) ? 0 :
                                  cdr2(car(aux)) == new_integer(1) ? 8 :
             cdr2(car(aux)) == new_integer(2) ? 16 : 32; 
   fprintf(c_target,
    "  *((U%d *)(((U8 *)result)+%d)) = (U%d)_%d;\n",
    w,  
    d + integer_value(second(car(aux))),
    w,
    k); 
   k++; 
   aux = cdr(aux); 
        }

      if (car(implem) == mixed_type && ind != 0)
        fprintf(c_target,"  result |= %d;\n",ind); 

      fprintf(c_target,"  return result;\n}\n\n"); 
    }
  ind++;
       }
   }
   break; 

 default: assert(0); 
 }
      
      fprintf(h_target,"\n"); 
    }

  fprintf(h_target,"\n\n"); 
  fprintf(c_target,"\n\n"); 
  fclose(h_target); 
  fclose(c_target); 
}