/*************************************************************************
 *                  
 *       (c) Copyright 1992,1993,1994 by G & A Technical Software, Inc.,
 *             28 Research Drive, Hampton, Virginia, 23666.
 *
 *   All Rights Reserved. No part of this software or publication may be
 *   reproduced, stored in a retrieval system, or transmitted, in any form
 *   or by any means, electronic, mechanical, photocopying, recording, or
 *   otherwise without the prior written permission of G & A Technical
 *   Software, Inc.
 *  
 *************************************************************************
 *
 * Filename:
 *
 * Purpose:
 *
 * Author:   John Burton
 *
 * Date:     5/31/94
 *
 *************************************************************************
 *
 * Modification History:
 *
 * $Log: s3_utilities.c,v $
 * Revision 2.1  1994/07/08  17:52:28  jcburt
 * Updated typedefs, defines and function protypes to allow recursive
 * parsing of pct files. Enabled use of sub-PDT files and scoping of
 * datasets. Datasets used in a pct must be defined either in the
 * associated pdt file or the pdt file associated with the direct
 * ancestors of the current pct file.
 *
 * DataSet functions and subroutines now have an additional parameter
 * passed to them, indicating the number of parameters passed in the
 * dataset list, i.e. was: function(DataSet **dl)
 *                    now: function(int nargs, DataSet **dl)
 * Parameters passed to the dataset routines from the PCT level are all
 * still contained in the dataset list, nargs is during the function or
 * subroutine call from s3_exec_enode
 *
 * Revision 2.0.0.1  1994/06/28  18:48:28  jcburt
 * S3 Version 2.0 Initial Source
 *
 * Revision 1.5  1993/09/09  17:54:58  jcburt
 * Initial Production Release of s3
 *
 * Revision 1.2  1992/12/01  18:35:32  jcburt
 * added RCS ID character string (rcsid) and RCS Log
 *
 *************************************************************************
 *
 * Revision Control Information:
 *
 *************************************************************************/

   static char rcsid[]  = "$Id: s3_utilities.c,v 2.1 1994/07/08 17:52:28 jcburt Exp $";
   static char rcsrev[] = "$Revision: 2.1 $";

/*************************************************************************
 * 
 * Include Files
 *
 *************************************************************************/

#include "s3_defines.h"
#include "s3_typedefs.h"
#include "s3_externals.h"
#include "s3_globals.h"


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
void set_EOL(char *pctname, char *list)
{
  ST_entry   *entry;
  Pnode      *pn;

  if((pctname == NULL) || (strlen(pctname) < 1))
    pn = (Pnode *)pct_info->current_pct;
  else
    {
      s3_dprint("set_EOL: name = %s,  list = %s",pctname,list);
      if((pn = (Pnode *)s3_get_symbol(pctname)) == NULL)
	s3_error(LOC,"set_EOL: symbol %s not found",pctname);
      if(pn->type != PNODE)
	s3_error(LOC,"set_EOL: symbol %s not of type PNODE",pctname);
    }
  xfree(pn->EOL);
  pn->EOL = strsave(list);
  s3_dprint("set_EOL: name = %s,  list = %s",pctname,list);
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
void set_EOI(char *pctname, int index)
{
  ST_entry   *entry;
  Pnode      *pn;


  if((pctname == NULL) || (strlen(pctname) < 1))
    pn = (Pnode *)pct_info->current_pct;
  else
    {
      s3_dprint("set_EOI: name = s%,  index = %d",pctname,index);
      if((pn = (Pnode *)s3_get_symbol(pctname)) == NULL)
	s3_error(LOC,"set_EOI: symbol %s not found",pctname);
      if(pn->type != PNODE)
	s3_error(LOC,"set_EOI: symbol %s not of type PNODE",pctname);
    }
  pn->EOI = index;
  s3_dprint("set_EOI: name = %s,  index = %d",pctname,index);
}




/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
char *get_EOL(char *pctname)
{
  ST_entry   *stentry;
  Pnode      *pn;
  char       *list;


  if((pctname == NULL) || (strlen(pctname) < 1))
    pn = (Pnode *)pct_info->current_pct;
  else
    {
      s3_dprint("get_EOL: name = %s",pctname);
      if((pn = (Pnode *)s3_get_symbol(pctname)) == NULL)
	s3_error(LOC,"get_EOL: symbol %s not found",pctname);
      if(pn->type != PNODE)
	s3_error(LOC,"get_EOL: symbol %s not of type PNODE",pctname);
    }
  s3_dprint("get_EOL: EOL = %s",pn->EOL);
  list = pn->EOL;
  s3_dprint("get_EOL: name = %s,  list = %s",pctname,list);
  return list;
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int get_EOI(char *pctname)
{
  ST_entry   *stentry;
  Pnode      *pn;
  int         index;


  if((pctname == NULL) || (strlen(pctname) < 1))
    pn = (Pnode *)pct_info->current_pct;
  else
    {
      s3_dprint("get_EOI: name = %s,  index = %d",pctname,index);
      if((pn = (Pnode *)s3_get_symbol(pctname)) == NULL)
	s3_error(LOC,"get_EOL: symbol %s not found",pctname);
      if(pn->type != PNODE)
	s3_error(LOC,"get_EOL: symbol %s not of type PNODE",pctname);
    }
  index = pn->EOI;
  s3_dprint("get_EOI: name = %s,  index = %d",pctname,index);
  return index;
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int get_eol(int nargs,DataSet **dl)
{
  char   *name, *list;

  s3_dprint("in Get_EOL");
  name = dl[0]->d.ch;
  list = get_EOL(name);
  s3_dprint("Get_EOL: name = %s,  list = %s",name,list);
  xfree(dl[1]->d.data); 
  dl[1]->d.data = (byte *)strsave(list);
  s3_dprint("Get_EOL: list = %s", dl[1]->d.data);
  return 0;
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int get_eoi(int nargs,DataSet **dl)
{
  char  *name;
  int    index;

  s3_dprint("in Get_EOI");
  name  = dl[0]->d.ch;
  index = get_EOI(name);
  *(dl[1]->d.in) = index;
  s3_dprint("Get_EOI: name = %s,  index = %d, EOI = %d",name,index,*(dl[1]->d.in));
  return 0;
}




/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int set_eol(int nargs, DataSet **dl)
{
  char   *name, *list;

  s3_dprint("in Set_EOL");
  name = dl[0]->d.ch;
  list = dl[1]->d.ch;
  set_EOL(name,list);
  return 0;
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int set_eoi(int nargs, DataSet **dl)
{
  char  *name;
  int    index;

  s3_dprint("in Set_EOI");
  name  = dl[0]->d.ch;
  index = *(dl[1]->d.in);
  set_EOI(name,index);
  return 0;
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int resize1(int nargs, DataSet **dl)
{
  ST_entry *tmp;
  char     buff[32];

  sprintf(buff,"%d",*(dl[1]->d.in));
  tmp = s3_lookup_symbol(buff);
  tmp->ss.type = CONST;
  tmp->co.value = *(dl[1]->d.in);
  dl[0]->dimlist[0] = tmp;

/* figure out the realloc part later */

  return 0;
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int resize2(int nargs, DataSet **dl)
{
  ST_entry *tmp;
  char     buff[32];

  sprintf(buff,"%d",*(dl[1]->d.in));
  tmp = s3_lookup_symbol(buff);
  tmp->ss.type = CONST;
  tmp->co.value = *(dl[1]->d.in);
  dl[0]->dimlist[0] = tmp;

  sprintf(buff,"%d",*(dl[2]->d.in));
  tmp = s3_lookup_symbol(buff);
  tmp->ss.type = CONST;
  tmp->co.value = *(dl[2]->d.in);
  dl[0]->dimlist[1] = tmp;

/* figure out the realloc part later */

  return 0;
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int resize3(int nargs, DataSet **dl)
{
  ST_entry *tmp;
  char     buff[32];

  sprintf(buff,"%d",*(dl[1]->d.in));
  tmp = s3_lookup_symbol(buff);
  tmp->ss.type = CONST;
  tmp->co.value = *(dl[1]->d.in);
  dl[0]->dimlist[0] = tmp;

  sprintf(buff,"%d",*(dl[2]->d.in));
  tmp = s3_lookup_symbol(buff);
  tmp->ss.type = CONST;
  tmp->co.value = *(dl[2]->d.in);
  dl[0]->dimlist[1] = tmp;

  sprintf(buff,"%d",*(dl[3]->d.in));
  tmp = s3_lookup_symbol(buff);
  tmp->ss.type = CONST;
  tmp->co.value = *(dl[3]->d.in);
  dl[0]->dimlist[2] = tmp;

/* figure out the realloc part later */

  return 0;
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int incr(int nargs, DataSet **dl)
{
  *(dl[0]->d.in) += *(dl[1]->d.in);
  return 0;
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int decr(int nargs, DataSet **dl)
{
  *(dl[0]->d.in) -= *(dl[1]->d.in);
  return 0;
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int if_then_else(int nargs, DataSet **dl)
{
  int tndx,fndx,test;

  test = *(dl[0]->d.in);
  tndx = *(dl[1]->d.in);
  fndx = *(dl[2]->d.in);
  if(test)
    set_EOI(NULL,tndx);
  else
    set_EOI(NULL,fndx);
  return 0;
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int dsz (int nargs, DataSet **dl)
{
  int cntrl,tndx;

  cntrl = *(dl[0]->d.in);
  tndx  = *(dl[1]->d.in);
  cntrl--;
  if(cntrl)
      set_EOI(NULL,tndx);
  *(dl[0]->d.in) = cntrl;
  return 0;
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int ise (int nargs, DataSet **dl)
{
  int count,stop,ndx;

  count = *(dl[0]->d.in);
  stop  = *(dl[1]->d.in);
  ndx   = *(dl[2]->d.in);
  if(count < stop)
    set_EOI(NULL,ndx);
  count++;
  *(dl[0]->d.in) = count;
  return 0;
}

int dse (int nargs, DataSet **dl)
{
   int count, stop, ndx;

  count = *(dl[0]->d.in);
  stop  = *(dl[1]->d.in);
  ndx   = *(dl[2]->d.in);
  if(count > stop)
    set_EOI(NULL,ndx);
  count--;
  *(dl[0]->d.in) = count;
  return 0;
}

/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int get_element1(int nargs, DataSet **dl)
{
  int ndx,type;

  ndx  = *(dl[2]->d.in) - 1;
  type = (int) dl[1]->type;
  switch(type)
    {
    case BYTE  : 
      *(dl[0]->d.by) = dl[1]->d.by[ndx];
      break;
    case STRING : 
      *(dl[0]->d.ch) = dl[1]->d.ch[ndx];
      break;
    case INT   :
      *(dl[0]->d.in) = dl[1]->d.in[ndx];
      break;
    case REAL  : 
      *(dl[0]->d.fl) = dl[1]->d.fl[ndx];
      break;
    case DREAL : 
      *(dl[0]->d.db) = dl[1]->d.db[ndx];
      break;
    case COMP  : 
      *(dl[0]->d.co) = dl[1]->d.co[ndx];
      break;
    case DCOMP : 
      *(dl[0]->d.dc) = dl[1]->d.dc[ndx];
      break;
    }
  return 0;
}





/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int get_element2(int nargs, DataSet **dl)
{
  int n1,n2,type,ndx;

  n1 = *(dl[2]->d.in) - 1;
  n2 = *(dl[3]->d.in) - 1;
  ndx = dl[0]->dimlist[0]->co.value * n1 + n2;
  type = (int) dl[1]->type;
  switch(type)
    {
    case BYTE  : 
      *(dl[0]->d.by) = dl[2]->d.by[ndx];
      break;
    case STRING : 
      *(dl[0]->d.ch) = dl[1]->d.ch[ndx];
      break;
    case INT   : 
      *(dl[0]->d.in) = dl[1]->d.in[ndx];
      break;
    case REAL  : 
      *(dl[0]->d.fl) = dl[1]->d.fl[ndx];
      break;
    case DREAL : 
      *(dl[0]->d.db) = dl[1]->d.db[ndx];
      break;
    case COMP  : 
      *(dl[0]->d.co) = dl[1]->d.co[ndx];
      break;
    case DCOMP : 
      *(dl[0]->d.dc) = dl[1]->d.dc[ndx];
      break;
    }
  return 0;
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
void call_system(int nargs, DataSet **dl)
{
  int i,result;

  for(i=0;i<nargs;i++)
    {
      printf("Calling %s...\n",dl[i]->d.ch);
      result = system(dl[i]->d.ch);
      printf("Returning From %s...return code = %d\n",
	     dl[i]->d.ch,result);
    }
}



/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
void copy_file(int nargs, DataSet **dl)
{
  int i,len;
  char *cmd;

  len = strlen(dl[0]->d.ch) + strlen(dl[1]->d.ch) + 5;
  cmd = strcat(strcpy((char *)xmalloc(len),"cp "),dl[0]->d.ch);
  cmd = strcat(cmd," ");
  cmd = strcat(cmd,dl[1]->d.ch);

  printf("Source file => %s\n",dl[0]->d.ch);
  printf("Destination file => %s\n",dl[1]->d.ch);
  printf("%s\n",cmd);
  i = system(cmd);
  printf("Returning From %s...return code = %d\n",cmd,i);
  xfree(cmd);
}


/*************************************************************************
 *
 * Module:
 *
 * Description:    
 *
 * Syntax:
 *
 * Inputs:
 * 
 * Outputs:
 *
 * Returns:
 *
 * Modules Called:
 *
 *************************************************************************/
int read_control_file(int nargs, DataSet **dl)
{
  char   *fname;

  s3_dprint("read_control_file: nargs  = %d\n",nargs);
  s3_dprint("read_control_file: param2 = %d (",*(dl[1]->d.in));
  fname = dl[0]->d.ch;
  if ((nargs == 2)&&(*(dl[1]->d.in) == TRUE))
    Global_Control_File = TRUE;
  if((s3_parse_control_file(fname)) > 0)
    s3_error(LOC,"Too many parse errors for Control File %s\n",fname);
  Global_Control_File = FALSE;
  return 0;
}