/*
 *  MODULE:  blktab.c
 *  block table
{*  last modification:  03.08.92  14:27   }
 *  uli 4.1.91 : prototypes added
 *  uli 04.03.89 : type optabptr added
 *  uli 06.03.91 : new style headers.
 *  uli 06.03.91 : stdio.h added.
 *  uli 14.06.91 : checkerror substituted by errput
 *  uli 21.08.91 : flag linkdispl added.
 *  PJ  03.08.92 : block table restriction for DEMOVERSION implemented.
*/

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

#include           "impor.t"
#include "error.h"
#include "scan.h"
#include "symtab.h"
#include "idtab.h"
#include "bintab.h"
#include "optab.h"
#include           "expor.t"
#include "blktab.h"

#include           "implemen.t"


#ifdef LINT_ARGS
local void   tracelist   (binptr, binptr);
local binptr addpoint    (binptr, binptr);
local void   tracerecord (binptr, binptr);
#else
local void   tracelist   ();
local binptr addpoint    ();
local void   tracerecord ();
#endif


/*-----------------------------------------------*/
/*----------- Zugriff ---------------------------*/
/*-----------------------------------------------*/


#ifdef LINT_ARGS
global blockptr blkfather ( blockptr block)
#else
global blockptr blkfather(block)
blockptr block;
#endif
{
 blockrec *bl;
 bl= block ? block->pred : NULL;
 return bl;
} /*blkfather*/


#ifdef LINT_ARGS
global idptr *blkptrid ( blockptr b)
#else
global idptr *blkptrid(b)
blockptr b;
#endif
{       return b?&(b->id):NULL;
} /*blkptrid*/


#ifdef LINT_ARGS
global idptr blkid ( blockptr b)
#else
global idptr blkid(b)
blockptr b;
#endif
{       return b?b->id:NULL;
} /*blkid*/


#ifdef LINT_ARGS
global optabptr   *blkop ( blockptr block)
#else
global optabptr   *blkop(block)
blockptr block;
#endif
{
 return block ? &(block->op) : NULL;
} /*blkop*/


#ifdef LINT_ARGS
global blkflags *blkflag ( blockptr blk,boolean set)
#else
global blkflags *blkflag(blk,set)
blockptr blk;
boolean set;
#endif
{       static blkflags dummy;
	blkflags *ret;

	if (blk) ret= &(blk->status);
	else
	{       if (set)     errput (9601, pos, NULL);
			/* NULL-Pointer assignment in blkflag */
		ret= &dummy;
	}
	return ret;
} /*blkflag*/


/*-----------------------------------------------*/
/*------------- Aendern -------------------------*/
/*-----------------------------------------------*/


#ifdef LINT_ARGS
global void blksetcf ( blockptr b,idptr idf)
#else
global void blksetcf(b, idf)
blockptr b;
idptr idf;
#endif
{       if (b) b->idfunc=idf;
} /*blksetcf*/


#ifdef LINT_ARGS
global void blksetfor ( blockptr block,boolean up)
#else
global void blksetfor(block,up)
blockptr block;
boolean up;
#endif
{       if (block) {
	   if ( up ) block->forward++;
	   else block->forward--;
	}
} /*blksetfor*/


/*-------------------------------------------*/


#ifdef LINT_ARGS
global blockrec *blkmake (  void)
#else
global blockrec *blkmake()
/* Creates and links a new block to blocktab    */
#endif
{ blockrec *block,*bl;

  /* PJ 03.08.92 */
#ifdef DEMOVERSION
#define MAXBLOCKS 15
  static blockrec blockarray[ MAXBLOCKS ];
  static blockrec *ba_ptr = &blockarray[ 0 ];
  static int blockcount = 0;

  if ( blockcount < MAXBLOCKS )
  { block = ba_ptr++;
    blockcount++;
  }
  else
  { char nstr[ 15 ];
    sprintf( nstr, "%d", MAXBLOCKS );
    errput( 5101, pos, &nstr );
              /* "demo version allows only MAXBLOCKS blocks."  */
    exit( -999 );
  }
#else
 block=(blockrec *)malloc(sizeof(blockrec));
 if (not block) then
   printf("Insufficient memory\n"), exit(-999);
#endif
 
 /* END PJ 03.08.92 */

 block->pred=actblock;
 block->succ=NULL;
 block->id=NULL;
 block->idfunc=NULL;
 block->op=NULL;
 block->forward=0;
 block->status.innerrout=false;
 block->status.innervar=false;
 block->status.innertype=false;
 block->status.iswith=false;
 block->status.linkdispl=false;

 if (actblock)
 begin
  if (actblock->succ)
  begin
   bl=actblock->succ;
   while (bl and bl->succ) bl=bl->succ;
   bl->succ=block;
  end
  else
   actblock->succ=block;
 end
 return block;
} /*blkmake*/


/*-------------------------------------------*/


#ifdef LINT_ARGS
global void blkbegin ( idptr id)
#else
global void blkbegin(id)
idptr id;
#endif
{
 blocklevel++;
 actblock=blkmake();
 if (id) {
  /*  blksetnam(actblock,id->sym);*/
    if (id->kind==IDFUNCTION)   idcurrf=id;
      else   idcurrf=NULL;
 }
 else   idcurrf=NULL;
 actblock->idfunc= idcurrf ;
} /*blkbegin*/


#ifdef LINT_ARGS
global void blkend ( void)
#else
global void blkend()
#endif
{
 int n;
 n=opforw (*blkop (actblock),actblock->forward);
 idforw (*blkptrid (actblock),n);
 if ( actblock->pred )   /* not top of list */
 {   actblock=actblock->pred;
     idcurrf=actblock->idfunc;
 }
 blocklevel--;

} /*blkend*/


/*-------------------------------------------*/


#ifdef LINT_ARGS
local void tracelist ( binptr list, binptr withvar)
#else
local void tracelist(list, withvar)
binptr list, withvar;
#endif
{    binptr typ;
     idptr id;

     typ=list;

     while (binsymc(typ)==cCsymbol or binsymc(typ)==cIdlist)
       typ=binnext(typ);                                   /* search type */
     while (binsymc(list)==cCsymbol or binsymc(list)==cIdlist)
     {                             /* for each element create idtab entry */
	     if (binsymc (list) == cCsymbol)
	       id=idins(binsym(list), IDVAR) ;
	     else  {
	       id=idins(idsym(binid(list)), IDVAR);
	       idsetcsym (id, idcsym(binid(list))) ;
	     }
	     if (not actblock->id) actblock->id=id;
	     idsetdatyp(id,typ);
	     idsetwith(id, withvar);
	     list=binnext(list);
     }

} /* tracelist */


/*-------------------------------------------*/


#ifdef LINT_ARGS
local binptr addpoint  ( binptr left, binptr right )
#else
local binptr addpoint (left, right)
binptr  left, right ;
#endif
{ binptr w ;
  w = bincreate (cPoint) ;
  binuppos (w, binpos(left)) ;
  binllink (w, left ) ;
  binrlink (w, right) ;          /*  unionname */
  return w ;
} /* addpoint */



/*-------------------------------------------*/


#ifdef LINT_ARGS
local void tracerecord  ( binptr root, binptr withvar)
#else
local void tracerecord (root, withvar)
binptr root, withvar;
#endif
{ binptr p = root ;     /* traverses record tree */

  if (binsymc(p)==cRECORD)
     p=binleft(p);
  while (binsymc(p)==cSemicolon)        /* travers constant part */
  {    tracelist(binleft(p), withvar);
       p=binnext(p);
  }
  tracelist(p, withvar);

  if (binsymc(root)!=cRECORD)   return ;
  p = binright (root) ;
  if (binsymc(p)!=cCASE)   return ;    /* variant part exists ? */

  withvar = addpoint (withvar, binleft(p)) ; /* add ".unionname" */
  p = binright (p) ;

  while (binsymc(p)==cSemicolon)
  {
    tracerecord(binright (binleft(p)),       /* add ".structname" */
		addpoint (withvar, binleft (binleft(p)))) ;
    p=binnext(p);
  }                                     /* travers variant part */

  tracerecord(binright(p),
	      addpoint (withvar, binleft(p))) ; /* add ".structname" */

} /* tracerecord */


#ifdef LINT_ARGS
global void blkwith ( binptr t,binptr withvar)
#else
global void blkwith(t, withvar)
  binptr t;       /* data type of the record */
  binptr withvar; /* variable between "with" and "do" */
#endif
{
     blocklevel++;

     actblock=blkmake();     /* new block */
     actblock->idfunc= idcurrf ;

     /* actblock->blocknam=symNIL; */
     blkfset(actblock,iswith);

     tracerecord (unname(t), withvar) ;

} /*blkwith*/
