%{
#pragma module MATH "X01-01"

/*
**
** Copyright 2009 James F. Duff.  ALL RIGHTS RESERVED.
**
** License Terms and Conditions:
**
** You may freely copy and distribute verbatim copies of this software package
** as you receive it, in any medium, provided that you conspicuously and
** appropriately publish on each copy this copyright notice and
** disclaimer of warranty; keep intact all the notices that refer to these
** license terms and conditions and to the absence of any warranty; and give
** any other recipients of the software package a copy of these license 
** terms and conditions along with the software.
**
** You may modify the software for your own use, but you MAY NOT distribute
** modified copies of the software.
**
** By copying or distributing the software package you indicate your
** acceptance of this license to do so, and all its terms and conditions.
**
** Each time you redistribute the software package the recipient
** automatically receives a license from the original licensor to copy,
** distribute or modify the software package subject to these terms and
** conditions. You may not impose any further restrictions on the recipients'
** exercise of the rights granted herein.
**
** BECAUSE THE SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
** FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
** OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDER PROVIDE THE SOFTWARE
** "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
** INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
** AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY
** AND PERFORMANCE OF THE SOFTWARE IS WITH YOU.  SHOULD THE SOFTWARE PROVE
** DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
** CORRECTION.
**
** YOU WARRANT THAT IN NO EVENT WILL THE COPYRIGHT HOLDER BE LIABLE TO
** YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
** CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
** SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED
** INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE
** SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE, FIRMWARE OR HARDWARE), EVEN IF
** SUCH HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
**
** NO TITLE TO AND OWNERSHIP OF THE SOFTWARE PACKAGE IS HEREBY TRANSFERRED.
**
** Send suggestions, bug reports, money ;-) to jim@eight-cubed.com
**
** Now that's out of the way, on with the code...
**
**--
*/

/*
**++
**
**  MODULE DESCRIPTION:
**
**	Support floating point functions from the DCL command line.  Allow
**	full infix calculations with the single argument C maths functions
**	all available.  Allow variables on the RHS to be read from DCL
**	symbols.  Allow the LHS to be set as a DCL symbol, either local or
**	global depending on the = or == signs.
**
**  AUTHORS:
**
**      James F. Duff
**
**  CREATION DATE:
**
**	01-Apr-2009
**
**  MODIFICATION HISTORY:
**
**      X01-00	    Jim Duff	    01-Apr-2009
**	Original version of module
**
**	X01-00	    Jim Duff	    05-Apr-2009
**	Handle the condition where the expression doesn't have a RHS.
**--
*/

#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#ifdef __ALPHA
#include <builtins.h>
#endif

/*
** Required for pow()
*/
#include <math.h>

#define YYERROR_VERBOSE 1
#define OP_PLUS 0
#define OP_MINUS 1
#define OP_MULT 2
#define OP_DIV 3

/*
** Function type.
*/
typedef double (*func_t) (double);

/*
** Data type for links in the chain of symbols.
*/
struct symrec {
    char *name; 
    int type;
    union {
	double var;
	func_t fnctptr;
    } value;
    struct symrec *next;
};

typedef struct symrec symrec;

/*
** Global declaration.
*/
static int gbl = FALSE;
static int rhs = FALSE;

/*
** Forward declarations
*/
static int yylex (void);
static void yyerror (char const *);
static void set_sym (double);
static double do_math (char *, double (*)(double), double);
static double do_op (double, double, int);
static symrec *putsym (char *, int);
static symrec *getsym (char const *);

%}

%union {
    double val;
    symrec *tptr;
}

%token <val> NUM
%token <tptr> VAR FNCT
%token <tptr> DOUBLEEQL "=="
%type <val> exp

%right '=' DOUBLEEQL
%left '-' '+'
%left '*' '/'
%left NEG
%right '^'

%%

input:	  /* empty */
	| line
;

line:	exp 			{ if (rhs) {
					set_sym ($1);
				  } else {
					(void)fprintf (stderr,
						       "parse error");
				  }
				}
;

exp:	  NUM 			{ $$ = $1;				}
	| VAR			{ $$ = $1->value.var;			}
	| VAR '=' exp		{ $$ = $3;
				  $1->value.var = $3;
				  gbl = FALSE;				}
	| VAR DOUBLEEQL exp	{ $$ = $3;
				  $1->value.var = $3;
				  gbl = TRUE;				}
	| FNCT '(' exp ')'	{ $$ = do_math ($1->name,
						$1->value.fnctptr, $3);	}
	| exp '+' exp		{ $$ = do_op ($1, $3, OP_PLUS);		}
	| exp '-' exp		{ $$ = do_op ($1, $3, OP_MINUS);	}
	| exp '*' exp		{ $$ = do_op ($1, $3, OP_MULT);		}
	| exp '/' exp		{ $$ = do_op ($1, $3, OP_DIV);		}
	| '-' exp %prec NEG	{ $$ = -$2;				}
	| exp '^' exp		{ $$ = pow ($1, $3);			}
	| '(' exp ')'		{ $$ = $2;				}
;

%%

#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <ssdef.h>
#include <stsdef.h>
#include <string.h>
#include <descrip.h>
#include <libdef.h>
#include <libclidef.h>
#include <lib$routines.h>
#include <starlet.h>

#define errchk_sig(arg) if (!$VMS_STATUS_SUCCESS(arg)) (void)lib$signal(arg);

struct init {
    char *fname;
    double (*fnct) (double);
};

/*
** Global variables
*/

static char dcl_target[255];
static struct dsc$descriptor_s dcl_target_d = { 0,
					        DSC$K_DTYPE_T,
					        DSC$K_CLASS_S,
					        dcl_target };

static struct init arith_fncts[] =
{ "SIN", sin,
  "COS", cos,
  "TAN", tan,
  "ASIN", asin,
  "ACOS", acos,
  "ATAN", atan,
  "SINH", sinh,
  "COSH", cosh,
  "TANH", tanh,
  "LN", log,
  "LOG", log10,
  "EXP", exp,
  "SQRT", sqrt,
  "CEIL", ceil,
  "FLOOR", floor,
  "FABS", fabs,
  0, 0
};

static char com_command[4096];

/*
** The symbol table: a chain of symrecs
*/
static symrec *sym_table;


/******************************************************************************/
static void yyerror (char const *s) {
/*
** Standard Bison error reporting routine.  Just write out the message.
*/

    (void)fprintf (stderr, "%s\n", s);
}


/******************************************************************************/
static void init_table (void) {
/*
** Put arithmetic functions in table.
*/
int i;
symrec *ptr;

    for (i = 0; arith_fncts[i].fname != 0; i++) {
	ptr = putsym (arith_fncts[i].fname, FNCT);
	ptr->value.fnctptr = arith_fncts[i].fnct;
    }
}


/******************************************************************************/
static symrec *putsym (char *sym_name, int sym_type) {
/*
** Add a symbol to the symbol table.  It's either a function symbol (that is,
** one of our reserved words for functions) or a variable.  If the variable
** is on the right hand side of the equals sign, the variable can potentially
** be an existant DCL local or global symbol.  If the variable is on the LHS,
** the symbol name will eventually be used to create/overwrite a DCL symbol.
*/
symrec *ptr;

int i;
int r0_status;

char buffer[255];

struct dsc$descriptor_d name_d = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL };
struct dsc$descriptor_d buffer_d = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL };

    ptr = (symrec *) malloc (sizeof (symrec));
    ptr->name = (char *) malloc (strlen (sym_name) + 1);
    strcpy (ptr->name,sym_name);
    ptr->type = sym_type;
    /*
    ** Set value to 0 even if fctn.
    */
    ptr->value.var = 0;

    if (sym_type == VAR) {
	if (!rhs) {
	    /*
	    ** A variable on the LHS.  Store it's name for later use to create
	    ** or overwrite a DCL symbol.
	    */
	    strcpy (dcl_target, sym_name);
	    dcl_target_d.dsc$w_length = strlen (sym_name);
	}

	/*
	** Let's see if the symbol we are storing is a DCL symbol already.  If
	** so, store the value away.  If we are on the RHS, a non-existant DCL
	** symbol reference is an error.
	*/
	name_d.dsc$w_length = strlen (sym_name);
	name_d.dsc$a_pointer = sym_name;
	buffer_d.dsc$w_length = sizeof (buffer);
	buffer_d.dsc$a_pointer = buffer;
	r0_status = lib$get_symbol (&name_d,
				    &buffer_d,
				    &buffer_d.dsc$w_length,
				    0);
	if (r0_status == LIB$_NOSUCHSYM) {
	    if (rhs) {
		(void)fprintf (stderr,
		               "DCL symbol \"%s\" undefined - "
		               "calculation not done\n",
		               sym_name);
	        exit (EXIT_FAILURE);
	    }
        } else {
	    errchk_sig (r0_status);

	    /*
	    ** Get the DCL's value into a double.
	    */
	    buffer[buffer_d.dsc$w_length] = '\0';
	    sscanf (buffer, "%lf", &ptr->value.var);
	    for (i = 0; i < strlen (buffer); i++) {
	        if (!isdigit (buffer[i]) &&
		    buffer[i] != '.' &&
		    buffer[i] != '-') {
		    (void)fprintf (stderr,
			           "DCL symbol \"%s\" has illegal chars - "
				   "result may not be what you intended\n",
			           sym_name);
		    break;
	        }
	    }
        }
    }
    ptr->next = (struct symrec *)sym_table;
    sym_table = ptr;
    return ptr;
}


/******************************************************************************/
static symrec *getsym (char const *sym_name) {
/*
** See if a symbol exists in the symbol table and return its address if so.
*/
symrec *ptr;

    for (ptr = sym_table; ptr != (symrec *) 0;
	ptr = (symrec *)ptr->next)
        if (strcmp (ptr->name,sym_name) == 0) {
	    return ptr;
        }
    return 0;
}


/******************************************************************************/
static int yylex (void) {
/*
** Bison lexer.  Read the command and return tokens and types.
*/

int c;
static char *p = com_command;

    c = *p++;

    if (c == '\0') {
	return 0;
    }

    /*
    ** Char starts a number => parse the number.
    */
    if (c == '.' || isdigit (c)) {
	--p;
	sscanf (p, "%lf", &yylval.val);
	while (c == '.' || isdigit (c)) {
	    c = *p++;
	} 
	--p;
	return NUM;
    }

    /*
    ** Char starts an identifier => read the name.
    */
    if (isalpha (c)) {
	symrec *s;
	static char *symbuf = 0;
	static int length = 0;
	int i;

	/*
	** Initially make the buffer long enough for a 40-character symbol
	** name.
	*/
	if (length == 0) {
	    length = 40, symbuf = (char *)malloc (length + 1);
	}
	i = 0;
	do {
	    /*
	    ** If buffer is full, make it bigger.
	    */
	    if (i == length) {
		length *= 2;
		symbuf = (char *) realloc (symbuf, length + 1);
	    }
	    /*
	    ** Add this character to the buffer.
	    */
	    symbuf[i++] = c;

	    /*
	    ** Get another character.
	    */
	    c = *p++;
	} while (isalnum (c));

	--p;;

	symbuf[i] = '\0';
	s = getsym (symbuf);
	if (s == 0) {
	    s = putsym (symbuf, VAR);
	}

	yylval.tptr = s;
	return s->type;
    }

    if (c == '=') {
	/*
	** If the character is an equals sign, we are now on the RHS.
	** If the equals sign is immediately followed by another equals sign,
	** tell the parser we saw a DOUBLEEQL token.
	*/
	rhs = TRUE;
	if (*p == '=') {
	    p++;
	    return DOUBLEEQL;
	}
    }

    /*
    ** Any other character is a token by itself.
    */
    return c;
}



/******************************************************************************/
static void set_sym (double value) {
/*
** Set a DCL symbol to a string representation of the double arg.
*/

int r0_status;
static int global_flag = LIB$K_CLI_GLOBAL_SYM;
static int local_flag = LIB$K_CLI_LOCAL_SYM;
static char dcl_str[255];
static struct dsc$descriptor_d dcl_str_d = { 0,
				             DSC$K_DTYPE_T,
				             DSC$K_CLASS_S,
				             dcl_str };

    dcl_str_d.dsc$w_length = sprintf (dcl_str, "%.10f", value);
    r0_status = lib$set_symbol (&dcl_target_d,
				&dcl_str_d,
				gbl ? &global_flag : &local_flag);
    errchk_sig (r0_status);
}


/******************************************************************************/
static int handler_fpe (int sigargs[], int mechargs[]) {
/*
** Let's ensure if we ever get a floating point error signalled, we deal
** with it.
*/
static int r0_status;
static int return_val;
static int i;
static int ss$_unwind = SS$_UNWIND;
static int ss$_hparith = SS$_HPARITH;
static int ss$_fltdiv = SS$_FLTDIV;
static int ss$_fltund = SS$_FLTUND;
static int ss$_fltovf = SS$_FLTOVF;
static int ss$_fltine = SS$_FLTINE;
static char *msgs[] = {
    "Complete",
    "Divide by zero error",
    "Floating point exponent overflow",
    "Floating point exponent underflow",
    "Floating point result not exact" };

    r0_status = lib$match_cond (&sigargs[1],
				&ss$_unwind,
				&ss$_hparith,
				&ss$_fltdiv,
				&ss$_fltovf,
				&ss$_fltund,
				&ss$_fltine);
    switch (r0_status) {
	case 0:
	    return_val = SS$_RESIGNAL;
	    break;
	case 1:
	    return_val = SS$_UNWIND;
	    break;
	case 2:
	    /*
	    ** For HPARITH errors on Alpha, decode the real error.
	    */
	    for (i = 1; i < 7; i++) {
		if ((sigargs[4] & (1<<i)) != 0) {
		    break;
		}
	    }
	    (void)fprintf (stderr,
			   "%s - result unpredictable\n",
			   msgs[i-1]);
	    return_val = SS$_CONTINUE;
	    break;
	case 3:
	case 4:
	case 5:
	case 6:
	    (void)fprintf (stderr,
			   "%s - result unpredictable\n",
			   msgs[r0_status - 2]);
	    return_val = SS$_CONTINUE;
	    break;
	default:
	    return_val = SS$_RESIGNAL;
	    break;
    }
    return return_val;
}


/******************************************************************************/
static double do_math (char *fname, double (*fnct)(double), double arg) {
/*
** Perform a single argument C math function.
*/
static double temp;
static char msg[255];

    temp = fnct (arg);
    if (errno != 0) {
	(void)snprintf (msg,
			sizeof (msg),
			"Invalid argument for %s - results undefined",
			fname);
        perror (msg);
	exit (EXIT_FAILURE);
    }
    return temp;
}


/******************************************************************************/
static double do_op (double a, double b, int op) {
/*
** This does the normal maths ops.  On alpha, we need to make the operations
** synchronous, hence this routine and all the trapb instructions.
*/
static double result;

    switch (op) {
	case OP_PLUS:
	    result = a + b;
#ifdef __ALPHA
	    __TRAPB ();
#endif /* __ALPHA */
	    break;
	case OP_MINUS:
	    result = a - b;
#ifdef __ALPHA
	    __TRAPB ();
#endif /* __ALPHA */
	    break;
	case OP_MULT:
	    result = a * b;
#ifdef __ALPHA
	    __TRAPB ();
#endif /* __ALPHA */
	    break;
	case OP_DIV:
	    result = a / b;
#ifdef __ALPHA
	    __TRAPB ();
#endif /* __ALPHA */
	    break;
	default:
	    fprintf (stderr, "Internal operations error!\n");
	    exit (EXIT_FAILURE);
	    break;
    }
    return result;
}


/******************************************************************************/
int main (int argc, char *argv[]) {

static int i;
static int j;
static int r0_status;
static char command[4096];
static struct dsc$descriptor_s command_d = { sizeof (command),
					     DSC$K_DTYPE_T,
					     DSC$K_CLASS_S,
					     command };

    /*
    ** Get the foreign command line.
    */
    r0_status = lib$get_foreign (&command_d,
				 0,
				 &command_d.dsc$w_length);
    errchk_sig (r0_status);

    /*
    ** Remove spaces so the lexer is easier to write.
    */
    for (i = j = 0; i < command_d.dsc$w_length; i++) {
	if (!isspace (command[i])) {
	    com_command[j++] = toupper (command[i]);
	}
    }
    com_command[j] = '\0';

    if (j > 0) {
        init_table ();

	lib$establish (handler_fpe);

        yyparse ();
    } else {
	(void)fprintf (stderr,
                       "Usage: MATH symbol =[=] mathamatical formula\n"
		       "\twhere symbol is a DCL symbol to be created/overwritten\n"
		       "\tand mathamatical formula is a standard infix calculation\n"
		       "\n"
		       "\tExamples:\n\n"
		       "\t\tMATH a = 2\n"
		       "\t\tMATH b = (a + 1) * 3\n"
		       "\t\tMATH c == sqrt (b)\n"
		       "\t\tMATH d'counter' = counter * 100 + 0.5\n\n"
		       "\tThe right hand side supports these function:\n\n"
		       "\t\tCOS, SIN, TAN, ACOS, ASIN, ATAN, COSH, SINH, TANH\n"
		       "\t\tLN, LOG, EXP, SQRT, CEIL, FLOOR, and FABS.\n\n"
		       "\tThe standard maths symbols are used: +, -, *, /, and ^\n"
		       "\tDCL symbols may appear on the RHS, as long as they\n"
		       "\texist and contain a floating point string.\n\n"
		       "\tAll normal DCL symbol subsitution is honoured.\n");
    }
}