%{
#include <stdio.h>
#include <stdlib.h>
#include <tcl.h>
#include <otcl.h>
#include <string.h>

#define SCAFFOLD 1 
#define MAXSIZE    4096
#define COMMAND     1
#define COMMAND_LIST 2
#define PROCESSED    8
#define MAX_NAME_LENGTH 64
#define mystrlen(a) (a? strlen(a): 0)

/* RE-ENRTANCY WARNING -- this code is not re-entrant */

char * CmdBuffer;
static int Ptr;
static int MaxBuf;
Tcl_Interp *  pTcl_Interp;
Tcl_Obj * pTemps;
struct OTclObject * pResultObj;
char  * ErrorString;
int   ErrorFlag;

   typedef struct qlist_s {
	int flags;
        char * command;
	char  * start;
	char  * done;
	char * opt_varlist;
	int  location;
        struct qlist_s * current_context;
	struct qlist_s * next_context;
  }qlist_t;
	

  void Reduction(char * string) {
	 return;
	 printf("%s\n",string);
  }

  void genmailbox( char * mbox_name, int count) {
	if (Ptr + 4096 > MaxBuf) {
	     MaxBuf += 4096;
	     CmdBuffer = (char*) realloc(CmdBuffer,MaxBuf);
	}
	sprintf(&CmdBuffer[Ptr],"mailbox %s %d\n",mbox_name,count);
	while(CmdBuffer[Ptr]) Ptr++;
  }

  void undefined_variable(char * varname) {
	char * error_string;
	error_string = (char *)malloc(strlen(varname) + 256);
	sprintf(error_string,"Undefined Variable %s",varname);
	yyerror(error_string);
	free(error_string);
}

  void genquad( qlist_t * pqlist) {
	char * input_vars;
	if (ErrorFlag == 1) return;
	if (pqlist->flags & PROCESSED) return;
	if (Ptr + 4096 > MaxBuf) {
	     MaxBuf += 4096;
	     CmdBuffer = (char*) realloc(CmdBuffer,MaxBuf);
	}
	   
	input_vars =  (pqlist->opt_varlist == 0 ? "" : pqlist->opt_varlist);
	sprintf(&CmdBuffer[Ptr], "action %d {%s} {%s} %s %s \n",
		pqlist->location, 
	        input_vars,
                pqlist->command, 
	        pqlist->start,
	        pqlist->done);
	while(CmdBuffer[Ptr])Ptr++;
	pqlist->flags |= PROCESSED;
  }

  void print_quads() {
	printf("%s",CmdBuffer);
  }

  void dummy() {}

  yyerror( char * error) {
	extern int Linenum;
	extern char * Input;
	char error_buff[256];
	
	sprintf(error_buff,
		"Error in task specification at %d: %s\n",Linenum,error);
	ErrorString = (char *)realloc(ErrorString,mystrlen(ErrorString) +
			              256);
	strcat(ErrorString,error_buff);
	if (CmdBuffer) {
	    free(CmdBuffer);
	    CmdBuffer = 0;
	    ErrorFlag  = 1;
	}
  }

  /* Decorate the entire parse tree under pqlist  by attaching a start symbol*/
  /* May output code if both start and finish symbols are there */
  void apply_start ( qlist_t * pqlist, char * symbol ) {
	qlist_t * qlist_ptr;
	if (pqlist->flags == COMMAND ) {
	  if ( pqlist->start == 0 ) {
	      pqlist->start = (char *) malloc (strlen(symbol));
	      strcpy(pqlist->start,symbol);
	  }
	  if (pqlist->start && pqlist->done)  genquad(pqlist);
	  if(pqlist->next_context) apply_start( pqlist->next_context,symbol);
	} else {
	  pqlist->start = (char *) malloc (strlen(symbol));
	  strcpy(pqlist->start,symbol);
	  if(pqlist->current_context) 
	     apply_start( pqlist->current_context,symbol);
	  if(pqlist->next_context) 
	     apply_start( pqlist->next_context,symbol);
	}
  }

  /* Decorate the entire parse tree under pqlist  by attaching a done symbol*/
  void apply_done ( qlist_t * pqlist, char * symbol ) {
	qlist_t * qlist_ptr;
	if (pqlist->flags == COMMAND) {
	  if ( pqlist->done == 0 ) {
	    pqlist->done = (char *) malloc (strlen(symbol));
	    strcpy(pqlist->done,symbol);
	  } 
	  if (pqlist->start && pqlist->done) genquad(pqlist);
	  if(pqlist->next_context) apply_done( pqlist->next_context,symbol);
	} else {
	   pqlist->done = (char *) malloc (strlen(symbol));
	   strcpy(pqlist->done,symbol);
	   if (pqlist->current_context) 
		   apply_done(pqlist->current_context,symbol);
	   if(pqlist->next_context) 
		   apply_done( pqlist->next_context,symbol);
	}
  }

  void free_qlist(qlist_t * pqlist) {
	if (pqlist->next_context == 0 && pqlist->current_context == 0) {
	   if(pqlist ->start ) free(pqlist->start);
	   if(pqlist->done)   free(pqlist->done);
	   if(pqlist->command) free(pqlist->command);
	   free(pqlist);
	 } else {
	   if (pqlist->next_context) free_qlist(pqlist->next_context);
	   if (pqlist->current_context) free_qlist(pqlist->current_context);
	   if (pqlist->start) free(pqlist->start);
	   if (pqlist->done) free(pqlist->done);
	   if (pqlist->command) free(pqlist->command);
	   free(pqlist);
	}
  }

  char * temp_stream (char * prefix) {
	static char  streamname[MAX_NAME_LENGTH];
	char   cmdbuffer[256];
	Tcl_Obj * pnewtemp;
	static int count;
#	ifdef SCAFFOLD
	sprintf(streamname,"%s%d",prefix,count++);
#       else
        sprintf(cmdbuffer,"stream_open %s -temp",prefix);
	if (Tcl_Eval(pTcl_Interp,cmdbuffer) != TCL_OK) {
	    fprintf(stderr,"%s",pTcl_Interp->result);
	    exit(-1);
	}
	strcpy(streamname,Tcl_GetStringResult(pTcl_Interp));
#	endif
	pnewtemp = Tcl_NewStringObj(streamname,strlen(streamname));
	Tcl_ListObjAppendElement(pTcl_Interp,pTemps,pnewtemp);
	return streamname;
   }

%}

%union {
        int              val       ;
        char              * string ;
	struct    qlist_s * pqlist ;
	}

%token BEGN END
%token CONCURRENT
%token SEQUENTIAL
%token MAILBOX
%token <string> SIMPLE_ID
%token <val> ICONST
%token TCL_CMD_BEGIN
%token TCL_CMD_END
%token <string> STRING
%token <string> ID
%token INPUT_VARS
%token AT
%type  <pqlist> stmts
%type  <pqlist> concurrent
%type  <pqlist> sequential
%type  <pqlist> basic_block

%%

program : { 
	         struct OTclClass * ptaskgraph;
	         CmdBuffer = 0; 
	         Ptr = 0; 
	         MaxBuf = 0;
	         pTemps = Tcl_NewListObj(0,0);
	         ErrorFlag = 0;
      } opt_mlist body  

body :  concurrent {
	         qlist_t * pqlist;
	         int length;
	         char * temp_string;
	         char  start_symbol[128];
		 char  done_symbol[128];
	         pqlist = $<pqlist>1;
		 strcpy(start_symbol,temp_stream("Start"));
		 apply_start(pqlist,start_symbol);
		 strcpy(done_symbol,temp_stream("Done"));
		 apply_done(pqlist,done_symbol);
	         free_qlist(pqlist);
	         temp_string = Tcl_GetStringFromObj(pTemps,&length);
                 OTclSetInstVar(pResultObj, pTcl_Interp,
                         "temps", temp_string,TCL_LEAVE_ERR_MSG) ;
                 OTclSetInstVar(pResultObj, pTcl_Interp,
                         "code", CmdBuffer,TCL_LEAVE_ERR_MSG);
                 OTclSetInstVar(pResultObj, pTcl_Interp,
                         "start_symbol", start_symbol,TCL_LEAVE_ERR_MSG);
                 OTclSetInstVar(pResultObj, pTcl_Interp,
                         "done_symbol", done_symbol,TCL_LEAVE_ERR_MSG);
	         if (pTemps) {
		     Tcl_DecrRefCount(pTemps);
	          }
		  Reduction("program->concurrent");
		} 
	        | sequential {
	            qlist_t * pqlist;
		    int length;
	            char  start_symbol[128];
		    char  done_symbol[128];
		    char * temp_string;
		    pqlist = $<pqlist>1;
		    strcpy(start_symbol,temp_stream("Start"));
		    apply_start(pqlist,start_symbol);
		    strcpy(done_symbol,temp_stream("Done"));
		    apply_done(pqlist,done_symbol);
	            free_qlist(pqlist);
	            temp_string = Tcl_GetStringFromObj(pTemps, &length);
                    OTclSetInstVar(pResultObj, pTcl_Interp,
                         "temps", temp_string,TCL_LEAVE_ERR_MSG);
                    OTclSetInstVar(pResultObj, pTcl_Interp,
                         "code", CmdBuffer,TCL_LEAVE_ERR_MSG);
                    OTclSetInstVar(pResultObj, pTcl_Interp,
                         "start_symbol", start_symbol,TCL_LEAVE_ERR_MSG);
                    OTclSetInstVar(pResultObj, pTcl_Interp,
                         "done_symbol", done_symbol,TCL_LEAVE_ERR_MSG);
	            if (pTemps) {
		      Tcl_DecrRefCount(pTemps);
	            }
	            Reduction("program->sequential");
	        }

mailbox : MAILBOX  ICONST { $<val>$ = yylval.val; } SIMPLE_ID  {
	  genmailbox(yylval.string, $<val>3);
	} 

opt_mlist: opt_mlist mailbox 
	 | mailbox
	 |;

stmts	:  concurrent  stmts {
	       qlist_t * pconc;
	       qlist_t * pstmts;
	       
	       pconc = $<pqlist>1;
	       pstmts = $<pqlist>2;
	       pconc->next_context = pstmts;
	       $<pqlist>$ = pconc;
	       Reduction ("stmts-> concurrent stmts");
	} 
	|  sequential stmts {
	       qlist_t * pseq;
	       qlist_t * pstmts;
	       
	       pseq = $<pqlist>1;
	       pstmts = $<pqlist>2;
	       pseq->next_context = pstmts;
	       $<pqlist>$ = pseq;
		Reduction ("stmts-> sequential stmts");
	}
	| concurrent {
	       $$ = $1;
	       Reduction ("stmts-> concurrent");
	}
	| sequential {
	       $$ = $1;
	       Reduction ("stmts-> sequential");
	} 
	| basic_block stmts {
	       qlist_t * pblock;
	       qlist_t * pstmts;
	       
	       
	       pblock = $<pqlist>1;
	       pstmts = $<pqlist>2;
	       /* Extend the chain in the current context block */
	       pblock->next_context = pstmts;
	       $<pqlist>$ = pblock;
	       Reduction ("stmts->basic_block stmts");
	}
	| basic_block   {
	       $<pqlist>$ = $<pqlist>1;
	       Reduction ("stmts->basic_block");
	}

concurrent : CONCURRENT BEGN  stmts  END {
	        /* 
		** Concurrent construct. Everybody in the concurrent construct
	        ** gets the same end symbol and start symbol but we defer 
	        ** assigning the start symbol until the enclosing context is 
		** known.
	        */
	        qlist_t * pqlist;
	        qlist_t * prev;
	        char * postcondition;
	        qlist_t * qlist_ptr;
	        pqlist =  (qlist_t *) malloc(sizeof(qlist_t));
	        memset(pqlist,0,sizeof(qlist_t));
	        pqlist->flags = COMMAND_LIST;
	        pqlist->current_context = $<pqlist>3;
	        /* all these guys share the same done symbol but the
	        ** start symbol is not known.
	        */
		// pqlist->done = postcondition;
		$<pqlist>$ = pqlist;
		Reduction ("concurrent-> CONCURRENT BEGN stmts END");

	} 

sequential : SEQUENTIAL BEGN stmts END {
	/* Serial construct */
	        qlist_t * pqlist;
	        qlist_t * prev;
	        char * postcondition = 0;
	        for (pqlist = $<pqlist>3, prev = 0; pqlist; 
		     prev = pqlist, pqlist = pqlist->next_context) {
	             if (prev) {
	               if (prev->done == 0) {
	                  postcondition = temp_stream("t");
	                  if (prev->current_context) 
			      apply_done(prev->current_context,postcondition);
		          prev->done = malloc(strlen(postcondition) + 1);
		          strcpy(prev->done,postcondition);
	               }
		       pqlist->start = malloc(strlen(prev->done) + 1);
		       strcpy(pqlist->start,prev->done);
	               if(pqlist->start && pqlist->done) genquad(pqlist);
		       if (pqlist->current_context) 
		           apply_start(pqlist->current_context,prev->done);
		     }
		}
	        /* Generate a new context block */
	        pqlist = (qlist_t *)malloc(sizeof(qlist_t));
	        memset(pqlist,0,sizeof(qlist_t));
		pqlist ->flags = COMMAND_LIST;
	        pqlist->current_context = $<pqlist>3;
		pqlist->done = postcondition;
	        $<pqlist>$ = pqlist;
		/* The pre-condition for this one is not yet known 
		** but it will be when we pop up to the enclosing context
		*/
		Reduction ("sequential-> SEQUENTIAL BEGN stmts END");
	} 

basic_block: AT ID {
	         char * val;
	         val = Tcl_GetVar(pTcl_Interp,&yylval.string[1],
					TCL_GLOBAL_ONLY);
	         if (val) {
	             $<val>$ = atoi(val);
		 } else {
		    undefined_variable(&yylval.string[1]);
		    break;
		 }
	     }  opt_varlist  TCL_CMD_BEGIN  STRING  {
		char * pchar ;
		pchar = malloc(strlen(yylval.string)); 
	        strcpy(pchar,yylval.string);
	        $<string>$ = pchar;
	     }  TCL_CMD_END  {
	        qlist_t * pqlist;
	        pqlist = (qlist_t * ) malloc (sizeof(qlist_t));
	        memset(pqlist,0,sizeof(qlist_t));
	        pqlist -> location = $<val>3;
	        pqlist -> command = $<string>7;
	        pqlist->opt_varlist = $<string>4;
	        $<pqlist>$ = pqlist;
	        pqlist->flags = COMMAND;
	        Reduction ("basic_block-> AT ID TCL_CMD_BEGIN  STRING TCL_CMD_END");
	     }
	     | AT ICONST { 
	        $<val>$ = yylval.val; 
	     }  opt_varlist TCL_CMD_BEGIN STRING { 
		char * pchar ;
		pchar = malloc(strlen(yylval.string)); 
	        strcpy(pchar,yylval.string);
	        $<string>$ = pchar;
	     }  TCL_CMD_END  {
	        qlist_t * pqlist;
	        pqlist = (qlist_t * ) malloc (sizeof(qlist_t));
	        memset(pqlist,0,sizeof(qlist_t));
	        pqlist -> command = $<string>7;
	        pqlist -> location = $<val>3;
	        pqlist->flags = COMMAND;
	        pqlist->opt_varlist = $<string>4;
	        $<pqlist>$ = pqlist;
	        Reduction ("basic_block->AT ICONST TCL_CMD_BEGIN STRING TCL_CMD_END");
	    } 

opt_varlist: INPUT_VARS ':' idlist { 
	     $<string>$ = $<string>3;
	   }
	   | {$<string>$ = 0 ; }

idlist: idlist ID { 
	char * result;
	char * nresult;
        result = Tcl_GetVar(pTcl_Interp,&yylval.string[1],TCL_GLOBAL_ONLY); 
	if (result == 0) {
	        undefined_variable(&yylval.string[1]);
		break;
	}
	dummy();
	nresult = realloc($<string>1,
		          strlen(result) + strlen(yylval.string) + 
		          strlen($<string>1) + 4);
	strcat(nresult," ");
	strcat(nresult,&yylval.string[1]);
	strcat(nresult," ");
	strcat(nresult,result);
	$<string>$ = nresult;
      } 
      | ID {
	char * result;
        result = Tcl_GetVar(pTcl_Interp,&yylval.string[1],TCL_GLOBAL_ONLY); 
	if (result == 0) {
	        undefined_variable(&yylval.string[1]);
		break;
	}
	$<string>$ = malloc(strlen(yylval.string) + strlen(result) + 4);
	strcpy($<string>$,&yylval.string[1]);
	strcat($<string>$," ");
	strcat($<string>$,result);
      }