/* *******************************************************************
 *                                                                   *
 * Copyright (c) L-DGO/MIT/JGOFS                                     *
 *                                                                   *
 *                                                                   *
 * File             : math.c                                         *
 *                                                                   *
 ******************************************************************* */
#define MATH_VERSION "math version 2.2e  21 Jul 2016"
/*
  21 Jul 16.  v 2.2e.  WJS
      Comment change/clarification
   9 Apr 16.  v 2.2e.  WJS
      Control PATH_INFO to ensure that this program gets ".jgof" format.
        Needed in "web" environment when processing local objects
      Improve jdbopen error text and include error status
        [Begin 2.2e]
   4 Sep 08.  v 2.2d.  WJS
      Validate input object arg a little bit
        [Needs mathex v 2.2c]
        [Needs jgmath.h v 1.4]
        [Begin 2.2d]

   6 Oct 06.  v 2.2c.  WJS
      Missed MISSING_VALUE_REAL parametrization last time
      30 Aug 04 comment incorrectly IDed itself as v 2.2b.  Fix that
  30 Aug 04.  v 2.2c.  WJS
      Use parameters, etc from core.h (now included in jgmath.h)
      Add version function
        [Needs mathex v 2.2c]
        [Needs jgmath.h v 1.4]
        [Begin 2.2c]

  12 Jan 99.  v 2.2b.  WJS
        Corrected jgmath.h version number below.  Deliberately did NOT
    upgrade date in math_id[] string - there may be multiple versions
    of this file differing only in these comments...
  11 Jan 99.  v 2.2b.  WJS
        Remove need for PARSAVSIZE via dynamic memory allocation
        Define HP & IBM if not explicity defined (avoids compile-time
    warnings from some compilers)
        Add iovaldouble_ entry.
        [Put on synthesis in test OO server ~12 Jan 99]
        [Needs mathex v 2.2a]
        [Needs jgmath.h v 1.3]
        [Begin 2.2b]

  12 Nov 98.  v 2.2a.  WJS
        Close a comment properly
        Incorporate mathex 2.2a bug fix.
        [Needs mathex v 2.2a]
        [Needs jgmath.h v 1.2]
        [Begin 2.2a]

   5 May 98.  v 2.2.  WJS
        Use := as equation separator
        Let parsex call error_ directly
        [Needs mathex v 2.2]
        [Needs jgmath.h v 1.2]
        [Begin 2.2]

  28 Apr 98.  v 2.1.  WJS
        Switch pcode arrays to union of signed & unsigned char so we can
    remove architecture references
        Parametrize PCODE_LEN.
        Switch variable number in pcode from 7 bits to 15.
        [Needs mathex v 2.1]
        [Needs jgmath.h v 1.1]
        [Never used]
        [Begin 2.1]

   2 Apr 98.  v 2.0.  WJS
        [Needs mathex v 2.0]
        [Needs jgmath.h v 1.0]
        [Put in globec's /optserver dir 14 Apr 98]
  ???    98   v 2.0   CLH
        Begin jgofs 1.5 mods to math.  Also, add width sensing
        [Comment by WJS]
  ?? May 96   v ???   CLH
        Make iovalreal do string/number decision on all chars of string
  17 Oct 92   v 1.1   GRF
*/

#include "jgmath.h"

  /*  jdb functions                                                     */
#include "jdbfuncdefns.h"
  /*  mathex functions                                                  */
void parsex();
void execute();
  /*  outer functions                                                   */
void error_();
  /*  utils routine (library)                                           */
char *buildstring();
  /*  path_info_routines routine (library)                              */
int new_and_old_path_infos();
#include "path_info_routines.h"

int nlevels;
int firstvar[MAXLEVELS+1];
int lev[NVAR],vpntr[NVAR];
int fldwidths[NVAR];

int name_array_size=VARNAMESIZE+1;
char names[NVAR][VARNAMESIZE+1];

int value_array_size=DATUMSIZE+1;
char values[NVAR][DATUMSIZE+1];

int handle;
int minlevelread;
int ncrit;

  /*    Each pstring is a copy of an equation (from a parameter         */
  /*  on the command line).  It used to be parsed into a 255 char temp  */
  /*  array by parsex, and then copied over the original equation, but  */
  /*  we've made another array here and eliminated the temp array.  2   */
  /*  arrays needed one way or the other, since there's no guarantee    */
  /*  that pcode string is at all times smaller than the equation (esp  */
  /*  since we increased the coded size of a variable number from 1 to  */
  /*  2 bytes.                                                          */
  /*    Max len of pcode was hardcoded at 255 chars in parsex.  Equa-   */
  /*  tion size has always exceeded 255.  Pcode size was never tested.  */
  /*  We parametrize but still don't test                               */
unsigned char pcode[MAX_EQUATIONS][PCODE_LEN+1];
char pstrings[MAX_EQUATIONS][INBUFSIZE+1+1];    /* Extra +1 for parsex  */
                                                /* which adds a $       */
int npstrings;

char newvar_attrs[MAX_NEW_VARS][TOTATTRSIZE+1];
int n_newvars = 0;

char comments[COMMENTSIZE+1];

/************************************************************************/

char *math_return_vers()
/*  Routine exists mostly to force .h file version string into this     */
/*  module, but we could call it if we want.  Note string must not be   */
/*  global or we'll have conflicts if another routine similarly         */
/*  includes the version string                                         */
{
  static char version[] =
        MATH_VERSION"/"FULL_JGMATHH_VERSION"/"FULL_JDBFUNCDEFNSH_VERSION;
  return version;
}

void docalc()
{
  int i;

  for (i=0; i<npstrings; i++)
    execute (pcode[i],values);

  return;
}

void doinit0(nparams,s,s0)
char *s[];
char s0[];
int *nparams;
  /*  s is a list of the parameters passed to math                      */
  /*    s[0] is the object math is going to work on.                    */
  /*    s[1]...s[nparams] are a mix of selections/projections and       */
  /*      equation strings                                              */
  /*  s0 is a copy of the object specifier, which we alter              */
  /*                                                                    */
  /*  Separate the equations from the projections and selections.       */
  /*  Separate the selections into those that apply to variables in     */
  /*    original object and those that apply to newly generated vars    */
{
  int i,j,k;
  char *sp;
  char *tmp;

  for (i=1; i<*nparams; i++)
    if (strstr(s[i],EQUATION_ID) != NULL) {
      strcat(comments,s[i]);
      strcat(comments,"\n");
      if (npstrings == MAX_EQUATIONS) error_("Too many equation strings","");
        /*  Rest of parsing depends on var=rest format, so replace all  */
        /*  EQUATION_ID strings with =s                                 */
      strcpy (pstrings[npstrings],s[i]);
      j = strlen(EQUATION_ID);
      sp = pstrings[npstrings++] - 1;
      while (  (sp = strstr(++sp,EQUATION_ID)) != NULL  ) {
        *sp = '=';
        strcpy(sp+1,sp+j);
      }
      s[i][0]='\0';
    }

    /*  Get buffer big enough to hold any s[i]                          */
  j = 0;
  for (i=1; i<*nparams; i++)
    if ( (k = strlen(s[i]) + 1) > j ) j=k;
  if ( (tmp = (char *)malloc(j)) == NULL )
    error_ (MATH_VERSION,"Could not get memory for tmp buffer in doinit0");

  for (i=1; i<*nparams; i++)
    if (s[i][0] != '\0') {

      strcpy(tmp,s[i]);

      if ( (sp=strpbrk(tmp,"<=>")) != NULL  )  {
          /* Process selection                                          */
        *(sp++) = '=';
        *sp = '\0';
        j = strlen(tmp);
        for (k=0; k<npstrings; k++)
          if (strncmp(pstrings[k],tmp,j) == 0) break;
        if (k == npstrings) {
            /*  Not found in equations, so this is an "old" variable    */
            /*  Tack it onto list to be passed to object's method       */
            /*  s0 is object spec                                       */
          j = strlen(s0);
          if (s0[j-1] == ')') s0[j-1]=',';
          else strcat(s0,"(");
          strcat(s0,s[i]);
          strcat(s0,")");
            /*  Mark this selection so math's outer doesn't process it  */
          s[i][0]='\0';
        }
      }
    }

  free (tmp);
  return;
}


void doinit1()
{
int i,j,k,m;
unsigned char *sp;

for (i=0; i<npstrings; i++) {
  parsex(pcode[i],pstrings[i],
                        names,firstvar+nlevels+1,newvar_attrs,&n_newvars);
  sp = pcode[i];
  k = 0;
  while (*sp) {
    if (*sp == 3) {
        /*  Variable # is 15 bits following "128" bit.                  */
      m = 256*((int)*(sp+1)-128) + (int)*(sp+2);
      sp += 3;
    } else if (*sp > 127) {
        /*  Variable # is 15 bits following "128" bit.                  */
      j = 256*((int)*sp-128) + (int)*(sp+1);
      j = lev[j];
      if (j > k) k=j;
      sp += 2;
    } else
      sp++;

    if ((*sp == ',') || (*sp == 0))  {
      lev[m] = k;
      if (k > ncrit) ncrit = k;
    }
  }
}
}

int ioreadrec_(level)
int *level;
{
  /*
     printf("** level %d  minlevelread %d \n",*level,minlevelread);
  */

  if (*level == minlevelread) {
    minlevelread= *level+1;
    return 1;
  } else if (*level > minlevelread) return 0;

  while (  *level <
                (minlevelread = jdbreada_(&handle,values,&value_array_size))  )
    ;

  if (minlevelread <= ncrit) docalc();

  if (*level == minlevelread) {
    minlevelread++;
    return 1;
  } else return 0;

}


void ioclose_()
{
  jdbclose_(&handle);
  return;
}

int ioopen_(s,nparams,ntotal)
char *s[];
int *nparams;
int *ntotal;
{
  char tmp[INBUFSIZE],*sp;
  int i,j,k,m,maxclev,nread;
      /* "PATH_INFO=" + getenv("PATH_INFO").  Must be static            */
      /*  since it "survives" in process table after ioopen_ exits)     */
  static char *PATH_INFO_orig_putenv;
      /* "PATH_INFO=" + getenv("PATH_INFO") w/ protocol = "jgof"        */
  char *PATH_INFO_jgof_putenv;

  if (*nparams < 0) error_("Negative number of parameters. ??","");
  if (*nparams == 0) error_("No input object","");
  if (strlen(s[0]) == 0) error_("No input object","");

  strcpy(tmp,s[0]);
  npstrings=0;
  doinit0(nparams,s,tmp);

  for (i=0;i<NVAR;i++) lev[i]= -1;

    /*  Avoid issues that arise when reading local objects in an html   */
    /*  environment.  See 30 Sep 97 note in join.c                      */
  if (new_and_old_path_infos(&PATH_INFO_jgof_putenv,&PATH_INFO_orig_putenv)
        != PATH_INFO_NEW_AND_OLD_OK) err
("problem processing PATH_INFO env var.  Memory issues or bad fmt. env var=",
                                                  getenv(PATH_INFO_ENV_VAR)  );

  if (PATH_INFO_jgof_putenv != NULL)
    if (  (i = putenv(PATH_INFO_jgof_putenv)) != 0  )
      err ("putenv failure for PATH_INFO",strerror(i));

  nread = -NVAR;
  maxclev=jdbopen_(&handle,tmp,names,&name_array_size,&nread);
  if (maxclev<0) {
    char jdb_status_error_buf[80];      /* Big enough to "do" next line */
    sprintf (jdb_status_error_buf,"\njdbopen_: %d",maxclev);
    error_(buildstring(
                "jdbopen problem trying to open object ",
                s[0],
                jdb_status_error_buf),
             ""
           );
  }


    /*  Restore original PATH_INFO if there was one             */
  if (PATH_INFO_orig_putenv != NULL)
        if (  (i = putenv(PATH_INFO_orig_putenv)) != 0  )
                err ("putenv failure restoring PATH_INFO: ",strerror(i));

  s[0][0]=0;
  *comments=0;
  while(jdbcomments_(&handle,tmp)) {
    strcat(comments,tmp);
    strcat(comments,"\n");
  }
  nlevels=0;
  firstvar[nlevels]=0;
  for(i=0;i<nread;i++){
    lev[i]=jdblevel_(&handle,&i);
    if (lev[i] > firstvar[nlevels]) firstvar[++nlevels]=lev[i];
  }
  firstvar[nlevels+1]=nread;

  ncrit=0;
  doinit1();

  k=0;
  *ntotal=firstvar[nlevels+1];
  for (i=0; i <= nlevels; i++)
    for (j=0; j < *ntotal; j++) if (lev[j]==i) vpntr[k++]=j;
  minlevelread = nlevels+1;
  return nlevels;
}

int iovarlevel_(vn)
int *vn;
{
  return lev[vpntr[*vn]];
}

void in_getwidth(vn, ptr)
/* read the width from the string 'ptr' (an attribute that has
        been tested prior to coming here for containing the
        string 'width=') and write it to the fldwidths array
        element '*vn'
*/
int *vn;
char *ptr;
{
  char *p;
  int len;
  p = strchr(ptr,'=');

  sscanf(p+1,"%d", &len);

  fldwidths[*vn] = len;
  return;
}

int ioattrout_(vn,str)
int *vn;
char *str;
{
   int j,newvar_number;
   char *ptr;

   j = vpntr[*vn];
     /*  Calculate position of var in sequence                          */
     /*    n_newvars...*ntotal, where position 0 = *ntotal-n_newvars    */
     /*  This is position "at the end" of the variable list, where the  */
     /*  new variables got added.  Before this position, vars are in    */
     /*  object, and attrs come from jdbattributes.  After, attrs were  */
     /*  entered when user entered equation defining variable           */
   newvar_number = j - (firstvar[nlevels+1] - n_newvars);

   if (newvar_number < 0) {
     if (jdbattributes_(&handle,&j,str) == 0) return 0;
   } else {
     if (newvar_attrs[newvar_number][0] == '\0') return 0;
     ptr = strchr(newvar_attrs[newvar_number],ATTRIB_SEP);
     if (ptr == NULL) {         /*  only attribute left for this var    */
       strcpy(str,newvar_attrs[newvar_number]);
       newvar_attrs[newvar_number][0] = '\0';
     } else {                   /*  more than 1 attribute               */
       *ptr = '\0';
       strcpy(str,newvar_attrs[newvar_number]);
       strcpy(newvar_attrs[newvar_number],ptr+1);
    }
  }

  if (strncmp(str,"width=",6) == 0) in_getwidth(&j,str);

  return 1;
}

void iovaldouble_(vn,f)
int *vn;
double *f;
{
  int i;
  char *end_char_ptr;

  i=vpntr[*vn];
  if (i < 0) {
    *f = MISSING_VALUE_REAL;
    return;
  }

/* following line changed by clh, May 1996
  if(strspn(values[vpntr[*vn]],"0123456789.+-"))
  to one below, to allow for strings that begin with digits
*/

  *f = strtod(values[i],&end_char_ptr);
  if (*end_char_ptr != '\0') *f= MISSING_VALUE_REAL;

  return;
}

void iovalreal_(vn,f)
int *vn;
float *f;
{
  double df;

  iovaldouble_(vn,&df);
  *f = df;

  return;
}

void iovalstr_(vn,tmp)
int *vn;
char *tmp;
{
  char *s;
  s=values[vpntr[*vn]];
  s=s+strspn(s," ");
  strcpy(tmp,s);

  return;
}

void ioname_(vn,s)
int *vn;
char *s;
{
  strcpy(s,names[vpntr[*vn]]);
  return;
}

int iocommout_(str)
char *str;
{
  char *at;

  if (comments[0] == '\0')
    return 0;
  else {
    at = strchr(comments,'\n');
    if (at) {
      *at = '\0';
      strcpy(str,comments);
      strcpy(comments,at+1);
    } else {
      strcpy(str,comments);
      comments[0] = '\0';
    }
    return 1;
  }

}

int iowidth_(vn)
int *vn;
{
   return fldwidths[vpntr[*vn]];
}