/* $Id: cgenstr.c,v 1.11 1995/12/21 15:13:30 cim Exp $ */

/* Copyright (C) 1994, 1998 Sverre Hvammen Johansen and Terje Mjøs,
 * Department of Informatics, University of Oslo.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

/* Legger ut C-kode for hvert blokk objekt. */

#include "const.h"
#include "dekl.h"
#include "cimcomp.h"
#include "error.h"
#include "extspec.h"
#include "mapline.h"
#include "name.h"

static short plevnull;		/* Hvis en blokks prefiksniv} er 0 s} er 
				 * plevnull=TRUE.Brukes for } initsialisere
				 * offset adressene til pekerne.M} vite om 
				 * structen til denne blokken inneholder   
				 * deklarasjonen struct dhp h.Ellers s} m} 
				 * .s f}lges plev ganger for } komme til h.pp 
				 */


static int naref;

static write_decl (rd, type, output_refs)
     struct DECL *rd; char *type, output_refs; 
{
  if (!output_refs)
    {
      fprintf (ccode, "\t%s %s;\n", type, rd->ident);
    }
}


static write_refs (rb, rd, atrib, output_refs) 
     struct BLOCK *rb; struct DECL *rd; char *atrib, output_refs;
{

  /* TBD Hvis rd alltil hadde vært forskjellig fra NULL kunne rb sløyfes
     og i stedet for rb->blno brukte man rd->encl->blno, Dersom
     de laged DECL objekter or et, er samt connester kan det gjøres.*/

  if (output_refs)
    fprintf (ccode, "(short)((char *)&((__bs%d *)0)->%s%s-(char *)0),",
	     rb->blno, rd==NULL?"":rd->ident, atrib);
  else
    naref++;
}




/******************************************************************************
                                                        DECLSTRUCTURE        */

static declstructure (rd, output_refs)
     struct DECL *rd;
     char output_refs;
{
  char write = 0;
  if (rd->kind == KSIMPLE)
    {
      if (rd->categ == CVAR)
	{
	  if (rd->type == TREF)
	    write_decl (rd, "__refvarpar ", output_refs);
	  else if (rd->type == TINTG || rd->type == TREAL)
	    write_decl (rd, "__aritvarpar ", output_refs);
	  else if (rd->type == TLABEL)
	    write_decl (rd, "__labelswitchpar ", output_refs);
	  else
	    write_decl (rd, "__varpar ", output_refs);

	  if (rd->type == TLABEL)
	    write_refs (rd->encl, rd, ".ob", output_refs);
	  else
	    write_refs (rd->encl, rd, ".bp", output_refs);
	}
      else if (rd->categ == CNAME)
	{
	  if (rd->type == TREF)
	    write_decl (rd, "__refnamepar ", output_refs);
	  else if (rd->type == TINTG || rd->type == TREAL)
	    write_decl (rd, "__aritnamepar ", output_refs);
	  else if (rd->type == TTEXT)
	    write_decl (rd, "__textnamepar ", output_refs);
	  else if (rd->type == TLABEL)
	    write_decl (rd, "__labelnamepar ", output_refs);
	  else
	    write_decl (rd, "__charboolnamepar ", output_refs);

	  if (rd->type == TLABEL)
	    write_refs (rd->encl, rd, ".ob", output_refs);
	  else
	    write_refs (rd->encl, rd, ".bp", output_refs);

	  if (rd->type == TLABEL)
	    write_refs (rd->encl, rd, ".sl", output_refs);
	  else
	    write_refs (rd->encl, rd, ".sl", output_refs);
	}
      else if (rd->categ == CCONST);
      else
	{
	  switch (rd->type)
	    {
	    case TINTG:
	      write_decl (rd, "long ", output_refs);
	      break;
	    case TREAL:
	      write_decl (rd, "double ", output_refs);
	      break;
	    case TBOOL:
	      write_decl (rd, "char ", output_refs);
	      break;
	    case TCHAR:
	      write_decl (rd, "char ", output_refs);
	      break;
	    case TLABEL:
	      if (rd->categ != CLOCAL)
		{
		  write_decl (rd, "__labelswitchpar ", output_refs);
		  write_refs (rd->encl, rd, ".ob", output_refs);
		}
	      break;
	    case TTEXT:
	      write_decl (rd, "__txt ", output_refs);
	      write_refs (rd->encl, rd, ".obj", output_refs);
	      break;
	    case TREF:
	      write_decl (rd, "__dhp ", output_refs);
	      write_refs (rd->encl, rd, "", output_refs);
	      break;
	    case TVOIDP:
	      write_decl (rd, "void *", output_refs);
	      break;
	    }
	  /* END-SWITCH */
	}
    }
  else if (rd->kind == KARRAY)
    {
      if (rd->type == TLABEL && rd->categ != CLOCAL)
	{
	  write_decl (rd, "__labelswitchpar ", output_refs);
	  write_refs (rd->encl, rd, ".ob", output_refs);
	}
      else if (rd->categ == CNAME)
	{
	  write_decl (rd, "__arraynamepar ", output_refs);
	  write_refs (rd->encl, rd, ".sl", output_refs);
	  write_refs (rd->encl, rd, ".ap", output_refs);
	}
      else
	{
	  write_decl (rd, "__arrp ", output_refs);

	  write_refs (rd->encl, rd, "", output_refs);
	}
    }
  else if (rd->kind == KPROC)
    {
      if (rd->categ == CDEFLT || rd->categ == CVAR)
	{
	  if (rd->type == TINTG || rd->type == TREAL)
	    write_decl (rd, "__aritprocpar ", output_refs);
	  else if (rd->type == TREF)
	    write_decl (rd, "__refprocpar ", output_refs);
	  else
	    write_decl (rd, "__forprocpar ", output_refs);

	  write_refs (rd->encl, rd, ".psl", output_refs);
	}
      else if (rd->categ == CNAME)
	{
	  if (rd->type == TINTG || rd->type == TREAL)
	    write_decl (rd, "__aritprocnamepar ", output_refs);
	  else if (rd->type == TREF)
	    write_decl (rd, "__refprocnamepar ", output_refs);
	  else
	    write_decl (rd, "__simpleprocnamepar ", output_refs);
	  write_refs (rd->encl, rd, ".psl", output_refs);
	  write_refs (rd->encl, rd, ".sl", output_refs);
	}
    }
}


/******************************************************************************
                                                         skrivprefikspp()    */

/* Hjelpe prosedyre som g}r rekursift gjennom prefikskjeden helt til
 * plev=0,og mens den trekker seg tilbake skriver den ut &p<blno til klassen>
 * til klassen.Kalles fra blockstructure for } initsiere prefiksarrayet
 * i prototypene.Da blir det slik at en prototype for en klasse p}
 * prefiksniv} n vil i arrayet sitt ha en peker til seg selv p} plass
 * 0,til sin superklasse p} plass n-1,dens superklasse p} plass n-2
 * osv. */

static skrivprefikspp (rd)
     struct DECL *rd;
{
  if (rd != NULL)
    {
      if (rd->plev > 0)
	{
	  skrivprefikspp (rd->prefqual);
	  fprintf (ccode, ",");
	}
    gen_adr_prot (ccode, rd);
    }
}



/******************************************************************************
                                                    BLOCKMAINSTRUCTURE       */

static blockmainstructure (rb, output_refs)
     struct BLOCK *rb; char output_refs;
{
  int i;
  struct DECL *rd;
  if (rb->quant.kind == KPROC && rb->quant.type != TNOTY)
    {
      if (rb->quant.type == TTEXT)
	write_refs (rb, NULL, "et.obj", output_refs); 
      else if (rb->quant.type == TREF)
	write_refs (rb, NULL, "er", output_refs); 
    }
  
  for (i = 1; i <= rb->connest; i++)
    {
      char s[10];
      sprintf (s, "c%d", i);
      write_refs (rb, NULL, s, output_refs);
    };
  
  for (rd = rb->parloc; rd != NULL; rd = rd->next)
    declstructure (rd, output_refs);
}

/******************************************************************************
                                                        BLOCKSTRUCTURE       */

static blockstructure (rb)
     struct BLOCK *rb;
{
  int i;
  struct DECL *rd;

#if 0
  if (rb->blno < 11)
    return;
#endif

  if (rb->structure_written)
    return;			/* Blokken er allerede behandlet */


  switch (rb->quant.kind)
    {
    case KPROC:
    case KCLASS:
    case KBLOKK:
    case KPRBLK:
      if (rb->quant.kind == KPROC)
	{
	  if (rb->quant.categ == CCPROC)
	    {
	      /* Extern C-prosedyre */
	      fprintf (ccode, "extern ");
	      switch (rb->quant.type)
		{
		case TTEXT:
		  fprintf (ccode, "char *");
		  break;
		case TINTG:
		  fprintf (ccode, "long ");
		  break;
		case TREAL:
		  fprintf (ccode, "double ");
		  break;
		case TBOOL:
		case TCHAR:
		  fprintf (ccode, "char ");
		  break;
		}
	      fprintf (ccode, "%s();\n", rb->rtname);
	      break;
	    }
	  else if (rb->codeclass != CCNO) break;
	}
      
      if ((rb->quant.kind == KCLASS || rb->quant.kind == KPROC) 
	  && rb->timestamp != 0 &&
	  rb->quant.encl->timestamp != rb->timestamp)
	{
	  
	  if (&rb->quant == classtext || &rb->quant == commonprefiks) break;
	  /* Definerer den eksterne modulen som extern på .h filen */
	  fprintf (ccode, "extern void __m_%s();\n",
		   rb->timestamp);

	}

      if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) 
	  && rb->timestamp == 0)
	{
	  fprintf (ccode, "extern __ptyp __p%d%s;\n", rb->blno,
		   timestamp);
	  for (rd = rb->virt; rd != NULL; rd = rd->next)
	    if (rd->kind == KPROC && rd->match!= NULL) 
	      blockstructure (rd->match->descr);
	}
      
      if ((rb->quant.kind == KCLASS && rb->quant.plev > 0) 
	  || (rb->quant.kind == KPRBLK))
	{				/* Går gjennom prefikskjeden */
	  blockstructure (rb->quant.prefqual->descr);
	  plevnull = FALSE;
	} 
      else
	plevnull= TRUE;

      fprintf (ccode, "typedef struct /* %s */\n    {\n"
	       ,rb->quant.ident == NULL ? "" : rb->quant.ident);

      if ((rb->quant.kind == KCLASS && rb->quant.plev > 0) 
	  || (rb->quant.kind == KPRBLK))
	fprintf (ccode, "        __bs%d s;\n",
		 rb->quant.prefqual->descr->blno);
      else
	fprintf (ccode, "        __dh h;\n");

      naref = 0;
      /* NB !!!. Deklarasjonene må skrives ut før evt. hjelpe variable 
   * (for,inspect) og før returverdivariabelen. Slipper da å skrive
   * ut disse i structene for virtuelle og formelle prosedyre 
   * spesifikasjoner. Gjelder prosedyrer. */
      blockmainstructure (rb, FALSE);

      if (rb->quant.kind == KPROC && rb->quant.type != TNOTY)
	{
	  if (rb->quant.type == TTEXT)
	    fprintf (ccode, "        __txt et;\n");
	  else if (rb->quant.type == TREF)
	    fprintf (ccode, "        __dhp er;\n");
	  else if (rb->quant.type == TINTG)
	    fprintf (ccode, "        long ev;\n");
	  else if (rb->quant.type == TREAL)
	    fprintf (ccode, "        double ef;\n");
	  else
	    fprintf (ccode, "        char ec;\n");
	}

      for (i = 1; i <= rb->fornest; i++)
	fprintf (ccode, "        short f%d;\n", i);
      for (i = 1; i <= rb->connest; i++)
	fprintf (ccode, "        __dhp c%d;\n", i);

      fprintf (ccode, "    } __bs%d;\n", rb->blno);

      if (rb->stat)
	{
	  if (rb->timestamp) fprintf (ccode, "extern ");
	  fprintf 
	    (ccode, "__bs%d __blokk%d%s;\n", rb->blno, rb->blno, 
	     rb->timestamp?rb->timestamp:timestamp);
	}

      if (rb->timestamp != 0)
	{
	  fprintf (ccode, "extern __ptyp __p%d%s;\n", rb->ptypno,
		   rb->timestamp);
	}
      else
	{
	  if (naref)
	    {
	      fprintf (ccode, "short __rl%d%s[%d]={", 
		       rb->blno, timestamp, naref);

	      blockmainstructure (rb, TRUE);

	      fprintf (ccode, "};\n");
	    }

	  if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) &&
	      (rb->navirt || rb->navirtlab))
	    {
	      if (rb->navirt)
		{
		  fprintf (ccode, "__pty   __vl%d%s[%d]={", 
			   rb->blno, timestamp, rb->navirt);
		  for (rd = rb->virt; rd != NULL; rd = rd->next)
		    {
		      if (rd->kind == KPROC)
			{
			  if (rd->match != NULL)
			    {
			      gen_adr_prot (ccode, rd->match);
			      fprintf (ccode, ",");
			    }
			  else
			    fprintf (ccode, "__NULL,");
			}
		    }
		  fprintf (ccode, "};\n");
		}

	      if (rb->navirtlab)
		{
		  fprintf (ccode, "__progadr   __labvl%d%s[%d]={", rb->blno,
			   timestamp, rb->navirtlab);
		  for (rd = rb->virt; rd != NULL; rd = rd->next)
		    {
		      if (rd->kind != KPROC)
			{
			  if (rd->match != NULL)
			    {
			      if (rd->match->plev == 0)
				rd->match->plev = newlabel ();

			      if (rd->match->encl->timestamp != 0)
				fprintf (ccode, "%d,__m_%s,",
					 rd->match->plev,
					 rd->match->encl->timestamp);
			  
			      else if (separat_comp)
				fprintf (ccode, "%d,__m_%s,",
					 rd->match->plev, timestamp);
			      else
				fprintf (ccode, "%d,__NULL,",
					 rd->match->plev);
			    }
			  else
			    fprintf (ccode, "0,__NULL,");
			}
		    }
		  fprintf (ccode, "};\n");
		}
	    }

	  fprintf (ccode, "extern __ptyp __p%d%s;__pty   __pl%d%s[%d]={", 
		   rb->blno, timestamp,
		   rb->blno, timestamp,
		   (rb->quant.prefqual==NULL)?1:
		   ((rb->quant.plev + 1 > DEF_PLEV_TAB_SIZE) ?
		    rb->quant.plev + 1 : DEF_PLEV_TAB_SIZE));
	  skrivprefikspp (&rb->quant);

	  fprintf (ccode, "};\n__ptyp __p%d%s={'%c',%d,%d,sizeof(__bs%d),%d,",
		   rb->blno, timestamp,
		   rb->quant.kind,
		   rb->quant.plev,
		   rb->blev, rb->blno,
		   rb->ent);

	  if (separat_comp && (rb->quant.kind == KCLASS 
			       || rb->quant.kind == KPROC ||
			       rb->quant.kind == KPRBLK))
	    fprintf (ccode, "__m_%s", timestamp);
	  else
	    fprintf (ccode, "0");

	  fprintf (ccode, ",%d,%d,%d,%d",
		   rb->fornest, 
		   rb->connest,
		   naref, 
		   rb->navirt);

	  if (naref)
	    fprintf (ccode, ",__rl%d%s", rb->blno, timestamp);
	  else
	    fprintf (ccode, ",0");

	  if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) && rb->navirt)
	    fprintf (ccode, ",__vl%d%s", rb->blno, timestamp);
	  else
	    fprintf (ccode, ",0");

	  fprintf (ccode, ",__pl%d%s", rb->blno, timestamp);

	  if ((rb->quant.kind == KCLASS || rb->quant.kind == KPRBLK) 
	      && rb->navirtlab)
	    fprintf (ccode, ",__labvl%d%s};\n", rb->blno, timestamp);
	  else
	    fprintf (ccode, ",__NULL};\n");

	}
      rb->structure_written = TRUE;	/* merker av at det er lagt ut type for denne 
				 * blokken */

  /* Sjekker om det må skrives ut structer for virtuelle- og formelle
   * prosedyre spesifikasjoner */
      if (rb->quant.kind == KCLASS || rb->quant.kind == KPROC)
	specifier_structure (rb);
      break;
    }
  for (rd= rb->parloc; rd!= NULL; rd= rd->next)
    {
      switch (rd->kind)
	{
	case KPROC:
	case KCLASS:
	case KBLOKK:
	case KPRBLK:
	case KFOR:
	case KINSP:
	case KCON:
	  blockstructure (rd->descr);
	  break;
	}
    }
}

specifier_proc_structure (rd)
     struct DECL *rd;
{
  struct DECL *rdi;
  if (rd->kind == KPROC)
    {
      if (rd->descr->parloc != NULL)
	{
	  fprintf 
	    (ccode, "typedef struct /* %s SPEC*/\n    {\n", rd->ident);
	  fprintf (ccode, "        __dh h;\n");
	  
	  /* Skriver alle parameterne */
	  for (rdi = rd->descr->parloc; rdi != NULL; rdi = rdi->next)
	    declstructure (rdi, FALSE);
	  fprintf (ccode, "    } __bs%d;\n", rd->descr->blno);
	  
	  /* Flere nivåer ? */
	  specifier_structure (rd->descr);
	}
      /* merker av at det er lagt ut type for denne blokken */
      rd->descr->structure_written = TRUE;
    }
}

specifier_structure (rb)
     struct BLOCK *rb;
{				/* Kaller på param_structure som skriver ut
				 * structer for evt. parameterspesifikasjoner 
				 * til virtuelle  og formelle prosedyre-
				 * spesifikasjoner. Altså kun for de som
				 * inneholder parametere. */

  struct DECL *rd,
   *rdi;

  /* Ser forst etter formell prosedyre spesifikasjoner */
  for (rd = rb->parloc; rd != NULL && (rd->categ == CDEFLT 
				       || rd->categ == CNAME &&
				       rd->categ == CVAR 
				       && rd->categ == CVALUE); rd = rd->next)
    specifier_proc_structure (rd);

  /* Går så gjennom den virtuele listen, og skriver ut for evt.  virtuelle
   * prosedyre spesifikasjoner */

  if (rb->quant.kind == KCLASS && rb->virt != NULL)
    {
      int i;
      /* Skal evt. bare skrive ut structene for de prosedyrene som ikke */
      /* er eller blir skrevet ut under behandlingen av prefiksklassen  */
      if (rb->quant.plev > 0)
	i = rb->quant.prefqual->descr->navirt +
	  rb->quant.prefqual->descr->navirtlab;
      else
	i = 0;
      for (rd = rb->virt; i-- > 0; rd = rd->next);
      /* Har nå funnet første 'nye' virtuelle spesifikasjon. */

      for (; rd != NULL; rd = rd->next)
	specifier_proc_structure (rd);
    }
}

/******************************************************************************
                                                                STRUCTURE    */

structure ()
{
  struct BLOCK *block;
  if (separat_comp)
    {
      fprintf (ccode, "void __m_%s();\n", timestamp);
    }
  genmap ();
  ssblock->timestamp= tag("FILE");
#if 0
  for (block = ssblock; block != NULL; block = block->next_block)
    {
      switch (block->quant.kind)
	{
	case KPROC:
	case KCLASS:
	case KBLOKK:
	case KPRBLK:
	  blockstructure (block);
	  break;
	default:
	  /* IKKE NOE UTLEGG */ ;
	}
    }
#else
    blockstructure (ssblock);
#endif
}

/******************************************************************************
								UPDATEGLNULL */

static void doForEachStatPointer (block) struct BLOCK *block;
{
  struct DECL *rd;
  switch (block->quant.kind)
    {
    case KPROC:
    case KCLASS:
    case KBLOKK:
    case KPRBLK:
      if (block->stat)
	fprintf (ccode, "if(((__dhp)&__blokk%d%s)->gl!=__NULL|force)"
		 "__do_for_each_pointer(&__blokk%d%s,doit,doit_notest);\n"
		 ,block->blno, timestamp, block->blno, 
		 block->timestamp?block->timestamp:timestamp);
    }
  for (rd= block->parloc; rd!= NULL; rd= rd->next)
    {
      switch (rd->kind)
	{
	case KPROC:
	case KCLASS:
	case KBLOKK:
	case KPRBLK:
	case KFOR:
	case KINSP:
	case KCON:
	  doForEachStatPointer (rd->descr);
	  break;
	}
    }
}

/******************************************************************************
								UPDATEGLNULL */

static void updateGlNull (block) struct BLOCK *block;
{
  struct DECL *rd;
  switch (block->quant.kind)
    {
    case KPROC:
    case KCLASS:
    case KBLOKK:
    case KPRBLK:
      if (block->stat)
	fprintf (ccode, "((__dhp)&__blokk%d%s)->gl=(__dhp)0;\n",block->blno, 
		 block->timestamp?block->timestamp:timestamp);
    }
  for (rd= block->parloc; rd!= NULL; rd= rd->next)
    {
      switch (rd->kind)
	{
	case KPROC:
	case KCLASS:
	case KBLOKK:
	case KPRBLK:
	case KFOR:
	case KINSP:
	case KCON:
	  updateGlNull (rd->descr);
	  break;
	}
    }
}

/******************************************************************************
								UPDATEGLOBJ */

static void updateGlObj (block) struct BLOCK *block;
{
  struct DECL *rd;
  switch (block->quant.kind)
    {
    case KPROC:
    case KCLASS:
    case KBLOKK:
    case KPRBLK:
      if (block->stat)
	fprintf 
	  (ccode, 
	   "if(((__dhp)&__blokk%d%s)->gl)((__dhp)&__blokk%d%s)->gl=(__dhp)&__blokk%d%s;\n"
	   ,block->blno, block->timestamp?block->timestamp:timestamp
	   ,block->blno, block->timestamp?block->timestamp:timestamp, 
	   block->blno, block->timestamp?block->timestamp:timestamp);
    }

  for (rd= block->parloc; rd!= NULL; rd= rd->next)
    {
      switch (rd->kind)
	{
	case KPROC:
	case KCLASS:
	case KBLOKK:
	case KPRBLK:
	case KFOR:
	case KINSP:
	case KCON:
	  updateGlObj (rd->descr);
	  break;
	}
    }
}

/******************************************************************************
                                                            STAT_POINTERS    */

stat_pointers ()
{
  struct BLOCK *block;
  struct stamp *st;

  if (!separat_comp)
    { /* TBD __init(){__init_FILE();__init_SIMENVIR(); should be removed */
      fprintf (ccode, "\n__init(){__init_FILE();__init_SIMENVIR();}\n");
      fprintf 
	(ccode, 
	 "__do_for_each_stat_pointer(doit,doit_notest,force)void(*doit)(),(*doit_notest)();int force;{\n");

      doForEachStatPointer (sblock);

      fprintf (ccode, "}\n__update_gl_to_obj(){\n");
      updateGlObj (sblock);


      fprintf (ccode, "}\n__update_gl_to_null(){\n");
      updateGlNull (sblock);

      fprintf (ccode, "}\n");
    }
}