%{
/* $Id: pxsc.y,v 1.11 1996/06/19 08:15:56 ae59 Exp ae59 $ */
/**********************************************************************
/* Description    : PXSC grammar (extension from ISO Pascal)          *
/**********************************************************************
 */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include "config.h"
#include "utils.h"

/*************************************************************************
 * macros                                                                *
 *************************************************************************
 */

#define YYERROR_VERBOSE

#define METRIC(str,z,nn)	printf("%s\t\t = %-5.2f \t%d\t%d\n",\
					str,(nn!=0)?(z)/(float)(nn):0.0,z,nn)
#define NTRACE(str,z)	printf("%s\t\t = %d\n",str,z)

#define POST(str) 		{if (TopBegin()<0) {int i=PopBegin();}\
					else if (level--,trace) \
						sprintf(outbuffer,"%s %s%s {%s|%d}{B %d }",\
						outbuffer,(str),(yychar==';')?";":"",\
						"",lines,PopBegin());}

#define PRE(str) 		{PushBegin(basic_blocks);\
					if (level++,trace) \
					 sprintf(outbuffer,"%s %s{%s|%d}{B %d }",\
						outbuffer,(str),\
						(level==0)?CurFct:"",lines,basic_blocks);\
					}
#define COUNT_LOOP 		{statemntno++;loop_decisions++;\
					decisions++; basic_blocks++;}

/* saves local values for a sub - routine call */
#define LOCAL_VALUES	{ \
			InitBegin();\
			PushVal(local_lines);local_lines=lines; \
		  	PushVal(local_inslines);local_inslines=inslines;\
		  	PushVal(local_blanklines);local_blanklines=blanklines;\
			PushVal(local_commentlines);local_commentlines= commentlines;\
			PushVal(local_xact_ops);local_xact_ops=exact_operations; \
			PushVal(local_reals);local_reals=real_decls; \
			PushVal(local_intervals);local_intervals=interval_decls; \
			PushVal(local_arithm_op);local_arithm_op=arithm_operators;\
			PushVal(local_recursion);local_recursion=recursion;\
					}

/* restores local values after a sub - routine call */
#define RESET_VALUES	{ \
					local_recursion=PopVal();\
					local_arithm_op=PopVal();\
					local_intervals=PopVal();\
					local_reals=PopVal();\
					local_xact_ops=PopVal() ;\
					local_commentlines=PopVal() ;\
				  	local_blanklines=PopVal();\
				  	local_inslines=PopVal();\
					local_lines=PopVal(); \
					Pop(CurFct);\
					Pop(CurArg);\
					atomic_pred_nodes=0;\
					checkbegin=0;\
					}

#define item 			int
#define YYSTYPE 		item
#define STACK_SIZE 		512
#define IDENTLIST_SIZE 	512
#define CUR_BUFF_LEN	256
#define PXSC_SYS 		"PXSC_SYS"

#define PushVal(val) {if (valuePtr< STACK_SIZE) \
					valueStack[++valuePtr]=val;\
				 else \
					fprintf(stderr,"Stack size exceeded (%d)\n",val);\
				}
#define PopVal() 	 ( valuePtr>=0)? valueStack[valuePtr--]:-1
#define TopVal()  	 ( valuePtr>=0)? valueStack[valuePtr]:-1 	
#define InitStack()  valuePtr=-1	

#define PushBegin(val) {	if (beginPtr< STACK_SIZE) \
						beginStack[++beginPtr]=val;\
				 	else \
						fprintf(stderr,"Stack size exceeded (%d)\n",val);\
					}

#define PopBegin() 	 ( beginPtr>=0)? beginStack[beginPtr--]:-1
#define TopBegin()  (( beginPtr>=0)? beginStack[beginPtr]:-1 	)
#define MrkBegin()   beginStack[beginPtr]=-beginStack[beginPtr]
#define InitBegin()  beginPtr=-1	

/*************************************************************************
 * local prototype                                                       *
 *************************************************************************
 */
_PROTOTYPE(char* Top,(char* stack));
_PROTOTYPE(int streq,(char* s1,char* s2));
/*************************************************************************
 * data types                                                            *
 *************************************************************************
 */
typedef struct callersList {
	struct functionList *call;
	struct callersList 	*next;
} CallersList;

typedef struct functionList {
	char 			name[80];
	int 				maccabe;
	struct functionList *next;
	CallersList        	*callers;
} FunctionList;

/*************************************************************************
 * extern variables                                                      *
 *************************************************************************
 */
extern 	FILE *yyin ;
extern 	int yychar ;
extern	char	yytext[];
extern	char	numbertext[80];
extern	char	*laststring;
extern	char	lastident[];

extern  	char	*create_string();
char outbuffer[255]={EOS};

/*************************************************************************
 * global variables                                                      *
 *************************************************************************
 */
int insidestring	= 0;
int newtyp		= 0;
int trace 		= 0;
int call  		= 0;
int nodes 		= 0;

int is_empty		= 1;
int level			= -1;

int nested		= 0;
int subroutines	= 0;
int reportid      	= 0;
int report_all    	= 0;  /* flags report of each routine         */
int echoinp      	= 0;  /* flags echo of input                  */ 
int metric       	= 0;  /* flags metric generation              */
int callgraph    	= 0;  /* flags call graph generation          */
int isglobal     	= 0;  /* flags global declaration             */
int isvar     		= 0;  /* flags var statement                  */
int report_vars  	= 0;  /* flags global declaration             */
int ignore_err   	= 0;  /* flags continue after error           */

int checkbegin		= 0;  /* flags control flow statments         */
int logic_expr		= 0;  /* flags logical expressions            */
char *FileName		= (char*)NULL;
char *addModPath	= (char*)NULL;


/* metrics' parameters */
int func				= 0;
int oper				= 0;
int proc				= 0;
int empty_decisions 	= 0;
int decisions			= 0;
int statemntno 		= 0;
int mods_nr    		= 0;
int globmods_nr    		= 0;

int atomic_predicates 	= 0;
int predicates 		= 0;
int atomic_pred_rels	= 0;

int loop_decisions		= 0;
int non_nested_decis	= 0;
int for_loop_decis 		= 0;

int array_decls		= 0;
int pointer_decls		= 0;
int file_decls			= 0;
int real_decls			= 0;
int complex_decls		= 0;
int interval_decls		= 0;
int basic_blocks		= 0;
int data_decls			= 0;

int defs   			= 0;
int c_uses			= 0;
int p_uses			= 0;

int exact_operations	= 0;
int arithm_operators	= 0;
int assignments		= 0;
int dots				= 0;
int idots				= 0;

int lines				= 1;
int blanklines			= 0;
int commentlines		= 0;
int recursion			= 0;
int prevlines			= 0;
int inslines			= 0;
int pathlen			= 0;
int vars   			= 0;
int mccabe 			= 0;

/*************************************************************************
 * static variables                                                      *
 *************************************************************************
 */
/* simple value stack */
static int valueStack[STACK_SIZE];
static int valuePtr;

/* simple begin stack */
static int beginStack[STACK_SIZE];
static int beginPtr;

static char RCSid[] = "$Id: pxsc.y,v 1.11 1996/06/19 08:15:56 ae59 Exp ae59 $";
static int atomic_pred_nodes=0;
static int local_blocks;
static int local_lines;
static int local_inslines;
static int local_blanklines;
static int local_commentlines;
static int local_xact_ops;
static int local_reals   ;
static int local_intervals;
static int local_arithm_op;
static int local_recursion;

static int lexical_level 	= 0;
static int correct_blocks	= 0;
static int param_level 		= 0;

/* buffers */
static char identlist[IDENTLIST_SIZE]={EOS};	/* holds list of identifiers   */
static char typelist[IDENTLIST_SIZE]={EOS};  /* holds list of var types     */
static char numtype[IDENTLIST_SIZE]={EOS};	/* holds list of num types     */

static char ModuleName[80]; 				/* holds current modules name  */
static char thistype [80]={EOS};			/* holds current type name     */
static char CurFctBuffer[CUR_BUFF_LEN];		/* holds current function name */
static char CurArgBuffer[CUR_BUFF_LEN];		/* holds argument of curren fct*/
static char CallBuffer[CUR_BUFF_LEN];

char *CurArg=(char*)CurArgBuffer;
char *CurFct=(char*)CurFctBuffer;
char *CurCall=(char*)CallBuffer;
char *NumType=(char*)numtype;
char	lastline[255]={EOS};


FunctionList * pFunctionTop = (FunctionList*) NULL;
FunctionList * pFunctionLast = (FunctionList*) NULL;

/*************************************************************************
 * subroutines                                                           *
 *************************************************************************
 */
/*************************************************************************
 * returns 1 if s1 == s2
 *         0 if s1 == s2
 * ignores capital,lower case letters
 *************************************************************************
 */
int streq(s1,s2)
char * s1, *s2;
{
	int i;
	int len=strlen(s1);
	if (strlen(s2)!= len) return 0;
	for (i=0;i<len; i++)
		if (toupper(s1[i])!= toupper(s2[i])) return 0;
	return 1;
}


/*************************************************************************
 * add thistype to type list if the buffer is big enough
 *************************************************************************
 */
void AddType(typ,thistype)
int typ;
char* thistype;
{
	int len =strlen(thistype)+1;
	char t[]={' ',typ,EOS};
	if (len+strlen(NumType)>= IDENTLIST_SIZE) return;
	strcat(NumType, t);
	strcat(NumType,thistype);
	/* printf("TYPE:%s\n", NumType);*/
	return;
}
/*************************************************************************
 * if flag == 1 increment if lastident was function name
 * else decrement (correct right hand side function
 * assignment
 *************************************************************************
 */
char CheckType(thistype)
char* thistype;
{
	char *t;
	if ((t=strstr(NumType, thistype)) !=NULL) return *(t-1);
	else return EOS;
}


/*************************************************************************
 * if flag == 1 increment if lastident was function name
 * else decrement (correct right hand side function
 * assignment
 *************************************************************************
 */
void CheckFct(flag)
int flag;
{
	/*static char last[80]={EOS};*/
	static retard=0; /* initial assignment */
	if (retard==1 && flag==1){
		recursion++;
		/* printf("REC: %s \n",Top(CurFct));*/
		retard=0;
	}

	if (streq(lastident,Top(CurFct))) 
	{
		retard=flag;
		/*strcpy(last,lastident);*/
	}
	return;
}

/*************************************************************************
 * gives top of the stack in a blank separated 
 * list as char*
 *************************************************************************
 */
char* Top(stack)
char *stack;
{
	static char buffer[255];
	char *tmp;
	*buffer=EOS;
	if (stack !=NULL) 
	{
		   tmp=stack+strlen(stack);
		   while (tmp>stack) if (*tmp==' ') break;
						   else tmp--;
		   strcpy(buffer,tmp+1); /* assign value */
	}
	return buffer;
}

/*************************************************************************
 * pop an entry from the stack in a blank separated 
 * list 
 *************************************************************************
 */
void Pop(stack)
char *stack;
{
	char *tmp;
	if (stack ==NULL) return;
	tmp=stack+strlen(stack);
	while (tmp>stack) if (*tmp==' ') break;
					else tmp--;
     tmp -= 3; /* cut off subroutine type description */
	*tmp=EOS;
	if (callgraph) printf("Leave %s \n\n", tmp+1);
	return /*tmp+1;*/;
}

/*************************************************************************
 * pushes an entry from the stack in a blank separated 
 * list and adds type as | additional entry in front of
 * name
 *************************************************************************
 */
void Push(stack,name,type)
char * stack;
char * name;
char type;
{
	char sep[]={' ',type, '|', ' ', EOS};
	strcat(stack,sep );
	strcat(stack,name);
	if (callgraph) printf("Enter %s %d\n", name, strlen(name));
	return;
}

void NewFunction(type,stack,name)
char type;  
char* stack;
char* name;
{
	/* allocate memory for temporary object */
	FunctionList* ptr;
	Push(stack,name,type);
	return;

	if ((ptr=(FunctionList*) malloc(sizeof(FunctionList))) == NULL)
	{
		puts("Warning I couldn't save subroutine status");
		return;
	}
	/* if list is empty then set top and bottom pointers */
	if (pFunctionLast ==NULL) pFunctionTop = ptr;
	else pFunctionLast->next=ptr;
	pFunctionLast=ptr;

	/* save name */
	ptr->next=(FunctionList*) NULL;
	ptr->callers=(CallersList*)NULL;
	ptr->maccabe=0;
	strcpy(ptr->name, name);
	return;
}

void CallFunction(name)
char* name;
{
	/*CallersList *tmp,*tmp2;*/
	if (callgraph) printf("--> %s line %d\n",name,lines);
	return;
/*
	if (pFunctionLast ==NULL) 
	{
		fprintf(stderr,"Found call of %s from outside of a subroutine \n",
		name);
		exit(1);
	}
*/
	/* search entry */
/*	tmp = tmp2 = pFunctionLast->callers;
	while (tmp2 != NULL) 
	{
		tmp=tmp2;
		if (strcmp(tmp2->call->name,name)!=0) return;
		else tmp2=tmp2->next;
	}
*/
	return;
}

void LeaveBody ()
{ 
	atomic_pred_nodes++; /* add one for the body */
	if (report_all) 
	{
		printf("%s%s : CCM = %d BB = %d REC = %d SLOC = %d ELOC = %d EXOP = %d ", 
			CurFct, Top(CurArg),
			atomic_pred_nodes, basic_blocks-local_blocks,
			recursion-local_recursion, lines-local_lines+1, 
			inslines-local_inslines+1,
			exact_operations-local_xact_ops);

		printf("REAL = %d INTV = %d ARIOP = %d\n", 
			real_decls-local_reals,
			interval_decls-local_intervals,
			arithm_operators-local_arithm_op);
	}
	mccabe+= atomic_pred_nodes; 
	level= -1;

	/* reset local counters */
	RESET_VALUES; 	/* resets values of nested functions*/
	return;
}

%}

%start program

%token UNSIGNED_INT UNSIGNED_REAL STRING IDENTIFIER
%token NE LE GE BECOMES DIV MOD NIL IN OR AND NOT DOTDOT
%token IF THEN ELSE EXTERNAL CASE OF REPEAT UNTIL WHILE DO FOR TO DOWNTO
%token SBEGIN END WITH GOTO CONST VAR TYPE ARRAY RECORD SET SFILE FUNCTION
%token PROCEDURE REALCC LABEL PACKED PROGRAM 
%token OPERATOR MODULE USE GLOBAL SUM PRIORITY DYNAMIC FORWARD
%token ADDD ADDU SUBD SUBU MULU MULD DIVU DIVD DOTN DOTU DOTD DOTI CCU CCD
%token HDS STARSTAR PSTAR GTLT
%token TBOOLEAN TCHAR TCOMPLEX TINTEGER TINTERVAL TSTRING TREAL  TTEXT

%%   /*start of rules*/
program		: MODULE {LOCAL_VALUES;} newident
		  	{	strcpy(ModuleName,lastident);
				NewFunction('F',CurFct,lastident);
			} ';' 
			  gluses  glblock '.'
			{ 	FlushFile(); 
				return 0; 
			}
			| PROGRAM  {LOCAL_VALUES;} newident 
			{	strcpy(ModuleName,lastident);
				NewFunction('f',CurFct,lastident);
			} 
			 external_files ';' uses block '.'
			{ 	FlushFile(); 
				return 0; 
			}
			| GLOBAL proc_dcl_part
			{ FlushFile(); 
				return 0; 
			}
			| proc_dcl_part
			{ 	FlushFile(); 
				return 0; 
			}
			;
external_files  : /*empty*/
			| '(' newident_list ')'
			;

uses			: USE uselist ';' uses
			| /* empty */
			;

gluses		: USE gluselist ';' gluses
			| /* empty */
			;

uselist		: uselist ',' newident {mods_nr++;}
			| newident {mods_nr++;}
			;

gluselist		: gluselist ',' GLOBAL newident {globmods_nr++;}
			| gluselist ',' newident {mods_nr++;}
			| GLOBAL newident {globmods_nr++;}
			| newident {mods_nr++;}
			;

glblock		: glopt_declarations  {LeaveBody();} END
			| glopt_declarations  statement_part
			;

block		: opt_declarations  statement_part
			;



glopt_declarations: /*empty*/
			| gldeclarations  
			;


gldeclarations	: gldeclarations gldeclaration	/*should be left-recursive*/
			| gldeclaration
			;

gldeclaration	: GLOBAL {isglobal=1;}const_dcl_part {isglobal=0;}
			| GLOBAL {isglobal=1;}gltp_dcl_part {isglobal=0;}
			| GLOBAL {isglobal=1;}glvar_dcl_part {isglobal=0;}
			| GLOBAL {isglobal=1;}proc_dcl_part 
			| GLOBAL {isglobal=1;}prio_dcl_part {isglobal=0;}
			| declaration
			;
opt_declarations: /*empty*/
			| declarations
			;
declarations	: declarations declaration	/*should be left-recursive*/
			| declaration
			;
declaration	: label_dcl_part
			| const_dcl_part
			| type_dcl_part
			| var_dcl_part
			| proc_dcl_part
			| prio_dcl_part
			;


label_dcl_part	: LABEL labels ';'
			;
labels		: labels ',' label
			| label
			;
label		: UNSIGNED_INT		/* 0 <= value <= 9999 [6.1.6] */
			;
const_dcl_part	: CONST const_defs ';'
			;
const_defs	: const_defs ';' const_def
			| const_def
			;
const_def		: newident '=' constant
			;

sign			: '+'
			| '-'
			;
constant		: unsigned_num
			| sign unsigned_num
			| const_ident				/*check it is constant*/
			| sign const_ident
			| STRING			/*type is char if len=1*/
			| '$' HDS
			| CCD signed_real ')'
			| CCU signed_real ')'
			;

signed_real 	: UNSIGNED_REAL
			| sign UNSIGNED_REAL
			;

unsigned_num	: UNSIGNED_INT
			| UNSIGNED_REAL
			;

gltp_dcl_part	: TYPE gltp_defs ';'
			;

gltp_defs		: gltp_defs ';' gltp_def
			| gltp_def
			;

gltp_def		: newident '='  { strcpy(thistype, lastident);} gltpdef
			{*thistype=EOS;}
			;

gltpdef		: GLOBAL type
			| type
			;

type_dcl_part	: TYPE type_defs ';'
			;

type_defs		: type_defs ';' type_def
			| type_def
			;

type_def		:  newident '=' { strcpy(thistype, lastident);} type 
			{*thistype=EOS;}
			;

type			: struct_type 
			| PACKED struct_type
			| simple_type
			| '^' IDENTIFIER    /*check forward reference semantics*/
			{ pointer_decls += newtyp;}
			;

stdard_type	: TBOOLEAN
			| TCHAR
			| TCOMPLEX 
			{if (isvar) {real_decls+=(2*newtyp);complex_decls+=newtyp;}
			 if (*thistype!=EOS) AddType('R',thistype);
			}
			| TINTEGER
			| TINTERVAL 
			{if (isvar) {real_decls+=(2*newtyp);interval_decls+=newtyp;}
			 if (*thistype!=EOS) AddType('I',thistype);
			}
			| TSTRING
			| TREAL 
			{if (isvar) real_decls+=newtyp;
			 if (*thistype!=EOS) AddType('R',thistype);
			 }
			| TTEXT 
			{if (isvar) file_decls += newtyp;}
			;
simple_type	: '(' newident_list ')'
			| constant DOTDOT constant
			| stdard_type
			| ident
			{char c= CheckType(lastident); 
				if (isvar) 
				{
				if (c=='R') real_decls+=newtyp;
				else if (c=='I') 
					{real_decls+=(2*newtyp);interval_decls+=newtyp;} 
				}
			 if (*thistype!=EOS) if (c != EOS) AddType('R',thistype);
			 }
			;

struct_type	: DYNAMIC ARRAY '[' index_exp_list ']' OF type
			{ array_decls += newtyp;}
			| ARRAY '[' index_exp_list ']' OF type 
			{ array_decls += newtyp;}
			| TSTRING '[' index_exp_list ']' OF type 
			{ array_decls += newtyp;}
			| TSTRING '[' index_exp_list ']' 
			{ array_decls += newtyp;}
			| IDENTIFIER '[' index_exp_list ']' 
			{ array_decls += newtyp;}
			| RECORD /*consider this a scope*/ field_list END
			| SET OF simple_type
			| SFILE OF type 
			{ file_decls += newtyp;}
			;

index_exp_list	: index_exp_list ',' array_bounds
			| array_bounds
			;
array_bounds	: simple_bounds
			| '*'
			;
simple_bounds 	: simple_bounds DOTDOT simple_bnd
			| simple_bnd
			;
simple_bnd 	: simple_expr
		/*	| simple_type*/
			;
field_list	: fixed_part
			| fixed_part ';' variant_part
			| variant_part
			;
fixed_part	: fixed_part ';' record_section
			| record_section
			;
record_section	: newident_list ':' type
			| /*empty*/
			;
variant_part	: CASE tag_field OF variants
			;
tag_field		: newident ':' ident 
			| ident /*type*/
			;
variants		: variants ';' variant
			| variant
			;
variant		: case_label_list ':' '(' field_list ')'
			| /*empty*/
			;

glvar_dcl_part	: VAR {isvar=1;} glvariable_dcls ';' {isvar=0;}
			;
glvariable_dcls: glvariable_dcls ';' glvariable_dcl
			| glvariable_dcl
			;
glvariable_dcl	: { 	newtyp=0; 
				*identlist=EOS;
				*typelist=EOS;
			  } 
			newident_list ':' { strcpy(typelist, yytext);} gltpdef
			{
			  if (report_vars )
			   printf("%s V|%s : %s\n", CurFct, identlist, typelist);
			}
			;

var_dcl_part	: VAR {isvar=1;} variable_dcls ';' {isvar=0;}
			;
variable_dcls	: variable_dcls ';' variable_dcl
			| variable_dcl
			;
variable_dcl	: {newtyp=0;} newident_list ':' type 
			;

newident_list	: new_id_list 
			;
new_id_list	: new_id_list ',' newident
			| newident
			{ if (isglobal) 
				if (IDENTLIST_SIZE> (strlen(identlist)+strlen(lastident)))
					{	strcat(identlist, " ");
			  			strcat(identlist, lastident);
			  		}
			  data_decls++;newtyp++;
			}
			;
prio_dcl_part	: PRIORITY priority_list ';'
			;
priority_list	: priority_list ';' prio_dcl
			| prio_dcl
			;
prio_dcl		: ident '=' op_priority 
			;
op_priority 	: add_op
			| mult_op
			| '='
			| '^'
			;
proc_dcl_part	: proc_or_func
			;
proc_or_func	: proc_heading ';' body ';'     /*check if forward or fwd refd*/
				{lexical_level--;
				}
			| func_heading ';' body ';'  /*also func heading may be -type */
				{lexical_level--;
				}
			| oper_heading ';' body ';'  /*also func heading may be -type */
				{lexical_level--;
				}
			| REALCC realconstconv IDENTIFIER ';'
			;

realconstconv	: /* empty */
			| CCU
			| CCD
			;
proc_heading	: PROCEDURE 
			{ LOCAL_VALUES; }
		  	fctident 
			{	
				if(param_level==0)
				{	
				 	proc++;
					NewFunction((isglobal)? 'P':'p',CurFct,lastident);
			 		isglobal=0;
					lexical_level++;
			 	}
			}
			formal_params
		;
func_heading	: FUNCTION
			{ LOCAL_VALUES; }
		  	fctident 
			{	if(param_level==0)
				{
					func++;
					NewFunction((isglobal)? 'F':'f',CurFct,lastident);
			 		isglobal=0;
					lexical_level++;
				}
			}
			function_form
			;

oper_heading	: OPERATOR
			{ LOCAL_VALUES; }
			{	if(param_level==0)
				{
					oper++;
				}
			}
			operator_class
			;
operator_class : BECOMES 
			{	NewFunction((isglobal)? 'O':'o',CurFct,lastline);
			 	isglobal=0;
			 	lexical_level++;
			} 
			ass_form
			| op_name 
			{	NewFunction((isglobal)? 'O':'o',CurFct,lastline);
				lexical_level++;
			}
			operator_form
			;

op_name		: add_op
			| mult_op
			| relational_op
			| newident 
			| NOT
			;
function_form	: /*empty*/			/*if forward referenced*/
			| formal_params ':' type 
			;

ass_form		: '(' {param_level++;} formal_ass_sects ')' {param_level--;}
			; /* assign operator */

operator_form	: '(' {param_level++;} formal_op_sects ')' {param_level--;} 
			ident ':' type   /* dyadic or monadic operators */
			;

body			: block
			/* result determined in block */
			| EXTERNAL IDENTIFIER		/* external directive*/
			{local_blocks=basic_blocks;LeaveBody();}
			| EXTERNAL 				/* external          */
			{local_blocks=basic_blocks;LeaveBody();}
			| FORWARD /* IDENTIFIER				directive-FORWARD*/
			{RESET_VALUES;}
			;
formal_params	: /*empty*/
			| '(' {param_level++;} formal_p_sects ')' {param_level--;}
			;
formal_ass_sects: formal_p_sect ';' formal_p_sect /* dyadic operator  */
			;
formal_op_sects: formal_p_sect ';' formal_p_sect /* dyadic operator  */
			| formal_p_sect                   /* monadic operator */
			;
formal_p_sects	: formal_p_sects ';' formal_p_sect
			| formal_p_sect
			;
formal_p_sect	: param_group
			| VAR param_group
			| proc_heading
				{lexical_level--;}
			| func_heading  {lexical_level--;}
			;
param_group	: newident_list ':' paramtype
			;
paramtype		: stdard_type
			| ident
			| ARRAY '[' index_specs ']' OF paramtype
			| PACKED ARRAY '[' index_spec ']' OF paramtype
			;
index_specs	: index_specs ';' index_spec
			| index_spec
			;
index_spec	: newident DOTDOT newident ':' ident
			;

statement_part	: {local_blocks=basic_blocks;} compound_stmt
			{ LeaveBody();}
			;

compound_stmt	:SBEGIN 
			{ if (checkbegin) checkbegin=0;
			  else { 	basic_blocks++;
			  		PRE("");
					printf("%s",outbuffer); 
					*outbuffer=EOS;
				  }
			}
			 statements END
			{ if (level--,trace) {printf("{%s|%d}{B %d } ",
						(level==-1)?CurFct:"",lines,TopBegin());
						MrkBegin();
					}
			}
			;

statements	: statements ';' statement
			| statement
			;


statement		: /*empty*/
			| label ':' statement
			{ statemntno++;}
			| compound_stmt
			{ statemntno++;}
			| assignment
			{ statemntno++;}
			| procedure_call
			{ statemntno++;}
			| GOTO label
			{ statemntno++;}
			| IF {logic_expr=1;} expression THEN  
			{ 
				checkbegin=1;
				basic_blocks++;
				statemntno++;
				decisions++;
				PRE("BEGIN");
			}
			statement {POST("END");} elsestmnt
			| CASE {logic_expr=1;} expression OF case_list END
			{ 	atomic_pred_nodes--; /* correction */ 
				statemntno++;
			}
			| WHILE {logic_expr=1;} expression DO 
			{	
				checkbegin=1;
				COUNT_LOOP;
				PRE("BEGIN"); 
			}
			statement  {POST("END");}
			| REPEAT  
			{COUNT_LOOP;PRE(""); printf("%s",outbuffer);*outbuffer=EOS;} 
			statements 
			{POST("");}  UNTIL {logic_expr=1;} 
			expression 
			| FOR ident BECOMES expression direction expression DO 
			{	
				atomic_pred_nodes++;
				checkbegin=1;
				COUNT_LOOP; 
				for_loop_decis++;
				PRE("BEGIN");
			} 
			statement  {POST("END");}
			| WITH rec_var_list DO  
			{	
				checkbegin=1;
			 	statemntno++;
				basic_blocks++;
				PRE("BEGIN");
			} statement  {POST("END");}
			;

elsestmnt		: ELSE 
			{	
				if (trace) {
					printf("%s%s",outbuffer,lastline); /* flush ELSE */
					*outbuffer=EOS;
				}
				checkbegin=1;
				basic_blocks++;
				PRE("BEGIN");
			} 
			statement  {POST("END");}
			| /* empty */
			;

direction		: TO
			| DOWNTO
			;

assignment	: variable BECOMES 
			{CheckFct(0); /* correct previous possible function lhs */} 
			expression	/* must test for fn_ident */
			{ 	assignments++;
			}
		/*	| ident BECOMES expression	*/
			;

procedure_call	: ident actual_params 
			;

actual_params	:  {CheckFct(1);} /*empty*/
			|  '(' {CheckFct(1);} actuals_list ')'
			

actuals_list	: actuals_list ',' actual_param
			| actual_param
			;

actual_param	: expression /* which could be a variable or a proc/fn id */
			| expression colon_things  /* only in i/o */
			;


colon_things   : ':' expression	/* integer */
			| ':' expression ':' expression 
			| ':' expression ':' expression ':' expression
			;

case_list		: case_list ';' case_list_elem
			| case_list_elem
			;

case_list_elem	: 	/*empty*/
			| case_label_list ':' 
			{	PRE("BEGIN");
				checkbegin=1;
				basic_blocks++;
			} statement
			{POST("END");}
			| ELSE 
			{ 
				if (trace) {
					printf("%s%s",outbuffer,lastline); /* flush ELSE */
					*outbuffer=EOS;
					}
			}
			':' 
			{	PRE("BEGIN");
				basic_blocks++;
				checkbegin=1;
			} statement
			{POST("END");}

case_label_list: case_label_list ',' case_label
			| case_label
			;
case_label	: constant
			{ decisions++; atomic_pred_nodes++;}
			| constant DOTDOT constant
			{ decisions++; atomic_pred_nodes++;}
			;

rec_var_list	: rec_var_list ',' record_var
			| record_var
			;

expression	: simple_expr
			{ if (logic_expr) {logic_expr=0; atomic_pred_nodes++;}}
			| simple_expr relational_op simple_expr
			{ if (logic_expr) {logic_expr=0; atomic_pred_nodes++;}
			  predicates++;}
			;

relational_op	: '='
			| '<'
			| '>'
			| LE
			| GE
			| NE
			| IN
			| GTLT
			;

dot_symbols  	: DOTN  {dots++;}
  			| DOTU  {dots++;}
  			| DOTD  {dots++;}
			| DOTI  {idots++;}
			| '#'   {dots++;} 
			{ arithm_operators++;exact_operations++;}
			;
accurate_expr	: dot_symbols '(' exact_expr ')' 
			;

exact_expr	: exa_expr
			| exact_expr sign exa_expr  
			{ arithm_operators++;exact_operations++;}
			;

exa_expr		: '(' exact_terms ')'
			| exact_terms
			;
exact_terms	: exact_term
			| sign exact_term
			{ arithm_operators++;exact_operations++;}
			;
exact_term	: FOR ident BECOMES expression direction expression 
			SUM '(' exact_expr ')'
			| operand '*' operand
			{ exact_operations++;arithm_operators++;}
			| operand
			; 

operand 		: ident '(' operand ')'
			| ident '(' operand ',' operand ')'
			| variable
			| constant
			;

simple_expr	: term
			| sign term
			| simple_expr add_op term
			{ arithm_operators++;}
			;

add_op		: sign
			| OR
			| ADDU
			| ADDD
			| SUBU
			| SUBD
			| PSTAR
			| newident 
			;

term			: factor
			| term mult_op factor
			{ arithm_operators++;}
			;

mult_op		: '*'
			| '/'
			| DIV
			| MOD
			| AND
			| MULU
			| MULD
			| DIVU
			| DIVD
			| STARSTAR
			| newident 
			;

factor		: variable		/* could be a const_ident of fn_call*/
			| '(' expression ')'
			| function_call 
			| set
			| NOT factor
			| constant
			| NIL
			| accurate_expr
			;


function_call	: ident actual_params 
			| stdard_type '(' actual_param ')'
			;

set			: '[' member_list ']'
			;

member_list	: /*empty*/
			| members
			;

members		: members ',' member
			| member
			;

member		: expression
			| expression DOTDOT expression
			;

/* kludge */
variable		: ident actual_params
			  /* check variable, const_id, fn_call */
			| variable '[' expressions ']'
			| variable '.' ident
			| variable '^'
			;

expressions	: expressions ',' index_expr
			| index_expr
			;
index_expr	: '*'
			| member
			;

record_var	: variable
			;

const_ident	: IDENTIFIER
			;
ident		: IDENTIFIER
			;

newident		: IDENTIFIER
			;

fctident		: IDENTIFIER
			|stdard_type
			;
%%   /*start of routines*/


void ntrace()
{
	NTRACE("empty_dec", empty_decisions);
	NTRACE("decision ", decisions );
	NTRACE("statement", statemntno );

	NTRACE("at pred  ", atomic_predicates  );
	NTRACE("pred     ", predicates  );
	NTRACE("pred rel ", atomic_pred_rels);

	NTRACE("loops    ", loop_decisions );
	NTRACE("nondec   ", non_nested_decis);
	NTRACE("for loo  ", for_loop_decis);

	NTRACE("ar_po_f  ", (array_decls+pointer_decls +file_decls ));
	NTRACE("datadec  ", data_decls);
	NTRACE("reldecls ", real_decls);
	NTRACE("intervals", interval_decls);
	NTRACE("complex", complex_decls);
	NTRACE("fildecls ", file_decls);

	NTRACE("defs     ", defs);
	NTRACE("cus      ",c_uses);
	NTRACE("pus      ",p_uses);
	NTRACE("ass      ", assignments);
	NTRACE("Arithm   ", arithm_operators);
	NTRACE("dots     ", dots   );
	NTRACE("idots    ", idots );
	NTRACE("pathlen  ", pathlen );
	NTRACE("insline  ", inslines);
	NTRACE("line     ",lines);
	NTRACE("blankline",blanklines);
	NTRACE("comment  ",commentlines);
	NTRACE("proc     ",proc);
	NTRACE("func     ",func);
	NTRACE("oper     ",oper);
	NTRACE("modules  ",mods_nr);
	NTRACE("glmodules",globmods_nr);
}
void report ()
{

	if (trace==1) ntrace();
#ifdef ALL
	METRIC("Z1 (empty_decs/decision)      ", empty_decisions,decisions );
	METRIC("Z2 (decision/1)               ", decisions,1 );
	METRIC("Z3 (decision/stm)             ", decisions,statemntno );

	METRIC("P1 (atomic_pred/decision)     ", atomic_predicates, decisions  );
	METRIC("P2 (predicates/decision)      ", predicates, decisions  );
	METRIC("P3 (predicates/atomic_pred)   ", predicates, atomic_predicates);
/*	METRIC("P4 (apred_rels/apred)        ", atomic_pred_rels, atomic_predicates);*/

	METRIC("S1 (loop_decision/decision)   ", loop_decisions,decisions );
/* 	METRIC("S2 (nnestdecs/loopdec)        ", non_nested_decis,loop_decisions);*/
	METRIC("S3 (forloopdec/loopdec)       ", for_loop_decis,loop_decisions);
#endif
	METRIC("D1 (array+ptr+file/dat_decl)  ",
				(array_decls+pointer_decls+file_decls ), data_decls);
	METRIC("D2 (real_decl/dat_decl)       ", real_decls,data_decls);
	METRIC("D3 (intervals/reals)          ", interval_decls,real_decls);
	METRIC("D4 (complex/reals)            ", complex_decls,real_decls);

#ifdef ALL
/*	METRIC("F1 (def+cus+pus/decs)         ", (defs+c_uses+p_uses),decisions);
	METRIC("F2 (defs/(cus+pus))           ", defs,(c_uses+p_uses));
	METRIC("F3 (cus/(defs+pus))           ", c_uses,(defs+p_uses));
	METRIC("F4 (pus/(def+cus))            ", p_uses,(defs+c_uses));
	METRIC("F5 (cus/(cus+pus))            ", c_uses,(c_uses+p_uses));
	METRIC("F6 (pus/(cus+pus))            ", p_uses,(c_uses+p_uses));*/
#endif
	METRIC("A1 (assign/decision)          ", assignments ,decisions);
	METRIC("A2 (arithm_opers/assig)       ", arithm_operators ,assignments);
	METRIC("A3 (dotprecs/1)               ", dots,1);
	METRIC("A4 (interval_dotpr/1)         ", idots,1);

	METRIC("M1 (arithm_opers/stm)         ", arithm_operators,statemntno);
	METRIC("M2 (dotprecs/arithm_opers)    ", dots ,arithm_operators);
	METRIC("M3 (path/(func+proc+oper))    ", pathlen ,(func+proc+oper));
	METRIC("M4 (alldots/exactops)         ", dots+idots ,exact_operations);

	METRIC("FPO (func+proc+oper/1)        ", (func+proc+oper),1);
	METRIC("ELOC (inslines/1)             ", inslines,1);
	METRIC("BLOC (blanklines/1)           ", blanklines,1);
	METRIC("SLOC (lines/1)                ", lines,1);
	METRIC("CLOC (commentlines/1)         ", commentlines,1);
	METRIC("L1 (ELOC/LOC)                 ", inslines,lines);
	METRIC("BB (basic_blocks/1)           ", basic_blocks,1);
	METRIC("REC (Recursion/1)             ", recursion,1);
	METRIC("CCM (McCabe/1)                ", mccabe,1);
}

void InitVars()
{
	extern void InitParserVars();

	   InitStack();
	   InitBegin();

	   InitParserVars();

	   insidestring		= 0;
	   newtyp				= 0;
	   call 		 		= 0;
	   nodes 				= 0;

	   is_empty			= 1;
	   level				= -1;
	   nested				= 0;
	   checkbegin			= 0;  /* flags control flow statments         */
	   logic_expr			= 0;  /* flags logical expressions            */


	   /* metrics' parameters */
	   func				= 0;
	   oper				= 0;
	   proc				= 0;
	   empty_decisions 		= 0;
	   decisions			= 0;
	   statemntno 			= 0;
	   mods_nr    			= 0;
	   globmods_nr    		= 0;

	   atomic_predicates 	= 0;
	   predicates 			= 0;
	   atomic_pred_rels		= 0;
	   loop_decisions		= 0;
	   non_nested_decis		= 0;
	   for_loop_decis		= 0;

	   array_decls			= 0;
	   pointer_decls		= 0;
	   file_decls			= 0;
	   real_decls			= 0;
	   complex_decls		= 0;
	   interval_decls		= 0;
	   basic_blocks		= 0;
	   data_decls			= 0;
	   recursion 			= 0;

	   defs   			= 0;
	   c_uses				= 0;
	   p_uses				= 0;

	   exact_operations		= 0;
	   arithm_operators		= 0;
	   assignments			= 0;
	   dots				= 0;
	   idots				= 0;

	   lines				= 1;
	   blanklines			= 0;
	   commentlines		= 0;
	   prevlines			= 0;
	   inslines			= 0;
	   pathlen			= 0;
	   vars   			= 0;
	   mccabe 			= 0;
	   atomic_pred_nodes	= 0;
	   local_blocks 		= 0;
	   local_lines 		= 1;
	   local_inslines 		= 0;
	   local_xact_ops		= 0;
	   local_reals   		= 0;
	   local_intervals		= 0;
	   local_arithm_op		= 0;


	   lexical_level 		= 0;
	   correct_blocks		= 0;

	   param_level 		= 0;
	   lastline[0]			= EOS;
	   *NumType			= EOS;
	   yyin				=(FILE*) NULL;
}

int main(argc, argv)
int argc;
char **argv;
{
	int 	cmdline_read;	
	int  count=0;
	int modfound=0;
	char *pxscsys;
	char *p88data;
	char *ext=NULL;
	char tmpname[255];

	pxscsys=getenv(PXSC_SYS);
	p88data=GetDataPath();

    	do
    	{
		  InitVars();
		  cmdline_read = GetOpt(argc, argv);
		  if ((count++!=0) && (cmdline_read==0)) break;
		  if (FileName== NULL) {FileName="stdin";yyin=stdin;}
		  if ((ext=strrchr(FileName,'.')) == NULL) ext=FileName;
		  modfound=0;
		  if (strstr(ext,".mod") || strstr(ext,".MOD"))
		  {
		     if ((yyin=fopen(FileName, "r"))==NULL) 
		     { 
			  if (p88data != NULL) 
			  {
				sprintf(tmpname,"%s%s",p88data, FileName);
		     	if ((yyin=fopen(tmpname, "r"))!=NULL)  
				{
					modfound=1;
					strcpy(FileName,tmpname);
				}
			  } 
			  if (pxscsys != NULL && modfound == 0) 
			  {
				sprintf(tmpname,"%s%s",pxscsys, FileName);
		     	modfound =((yyin=fopen(tmpname, "r"))!=NULL)  ;
				strcpy(FileName,tmpname);
			  }
			  if (addModPath != NULL && modfound == 0) 
			  {
				sprintf(tmpname,"%s%s",addModPath, FileName);
		     	modfound =((yyin=fopen(tmpname, "r"))!=NULL)  ;
				strcpy(FileName,tmpname);
			  }
			  if ( modfound == 0) 
			  {
				sprintf(tmpname,"/usr/pxsc/sys/%s", FileName);
		     	modfound =((yyin=fopen(tmpname, "r"))!=NULL)  ;
				strcpy(FileName,tmpname);
			  }
			  if (modfound==0)
			  {
		  	  		fprintf(stderr,"Sorry, file %s not found.\n",FileName);
					continue;
			  }
		     }
			ParseMod(yyin,FileName);
		  }
		  else 
		  {
		      if (yyin!=stdin) 
			  if ((yyin=fopen(FileName, "r"))==NULL) 
		       { 
		  	    fprintf(stderr,"Sorry, file %s not found.\n",FileName);
			    continue;
		       }
			yyparse();
		  	parser_info(); 
		  }
		  if (metric) report ();
		  if (yyin!=stdin) fclose(yyin);
    	} while (!(cmdline_read==0));
    	exit(0);
}
