/* @(#)prepc2.c	17.1.1.2 (ESO-DMD) 02/25/02 17:53:04 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*++++++++++++++++++++++++  MIDAS monitor routines PREPC2  +++++++++++++++++++++
.LANGUAGE  C
.IDENTIFICATION	Module PREPC2
.AUTHOR		K. Banse                  ESO - Garching
.KEYWORDS
  MIDAS monitor
.COMMENTS
  holds PARSE, SAVE_PARM, CROSS_PARM, CLEAR_LOCAL
        ECHO_line, CATALO, DSC_write
.VERSION
 [1.00] 870907: pulled out from original PREPC.C

 020221		last modif

------------------------------------------------------------------------------*/
 
#include <fileexts.h>

#include <osyparms.h>
#include <monitdef.h>
#include <midback.h>
 
#include <stdlib.h>
#include <fsydef.h>

 
static char   asci[9] = {'0','1','2','3','4','5','6','7','8'};
static char   logstrng[MAX_LINE];



/*

*/

void ECHO_line(cptr,lc,lev)
char  *cptr;
int   lc, lev;

{
int  ia, iw;

char *mypntr;


if (lev >= 0)
   (void) sprintf(logstrng," %d > ",lev);
else
   (void) strcpy(logstrng,"     ");


if (lc > 75)
   {
   ia = 75;
   (void) strncpy(&logstrng[5],cptr,ia);
   logstrng[80] = '\0';
   SCTSYS(logstrng);		/* send buffer of 80 char. to SCTPUT */

   (void) strcpy(logstrng,"     ");
   mypntr = cptr + ia;                 /* point to 2. chunk */
   for (iw=ia; iw<lc; iw+=ia)
      {
      (void) strncpy(&logstrng[5],mypntr,ia);
      SCTSYS(logstrng);
      mypntr += ia;
      }
   }
else
   {
   (void) strcpy(&logstrng[5],cptr);
   SCTSYS(logstrng);
   }
}
  
/*

*/
 
int PARSE(sw,parsecho,level)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  1) parse a given input string (atoms are limited by ' ') until EOL
  or '!' (exclamation mark indicates start of comment as in FORTRAN 77)
  2) replace parameters (P1,..,P8) (parameters are limited in the end by ' ' or
  3) replace variables (variables are prepceded by an apostrophe)
  4) log raw + substituted input line
.ALGORITHM
  get start of line + use Parse2 to extract different atoms
  (called TOKEN) + get their length in bytes and save total no. of tokens
.RETURNS
  return status, = 0: o.k.
	       else parsing error as described in SYSERR.DAT
---------------------------------------------------------------------*/
 
int sw;         /* IN: switch for parsing
                = -1, as 0 but more diagnostics
                = 0, basic parsing (compilation of procedures)
                = 1, full parsing (terminal input passed to `prepx')
		= 2, full parsing (execution of procedures) */
 
int parsecho;   /* IN: echo for parsing  */
int level;      /* IN: current procedure level  */

{
int   kk, left, lsave, nn, expand;
int   parno, substi, escapa;
int   n, mm, stat, start, jk;
register int  nr;
 
char	wbuf[2*MAX_TOKEN];

	
/*  initialize + check LINE.LEN   */
 
first_line:

MONIT.COUNT = 0 ;			/* init MONIT.COUNT */
if (LINE.LEN <= 0) return (0);		/* nothing to parse...  */


/*  if it's a basic parsing (sw=-1,0,1) we find "real" start of line
    (= first non-blank char.)                                       */
	

if (sw < 2)
   {
   for (nr=0; nr<LINE.LEN; nr++)
      {
      if (LINE.STR[nr] != ' ') 
         {
         start = nr;
         goto step_1;
         }
      }
   return (0);				/* nothing there */
   }
else
   start = 0;				/* we work on a "clean" line ...  */
 
	
/*  extract all tokens + get their length */
 
step_1:
parsing_loop:
expand = 0;
substi = 0 ;					/* init substitution flag  */
 
jk = Parse2(sw,start);
if (jk < 0)
   return (jk);
else
   MONIT.COUNT = jk;
 

if (sw < 1) return (0);		/* if basic 'batch' parsing, we're done...  */
 
if (parsecho > 0) 
   ECHO_line(LINE.STR,LINE.LEN,level);	/*  log raw input line if ECHO/ON  */
 

/* lines beginning with $$... are changed to $...  and nothing else */

if ((TOKEN[0].STR[0] == '$') && (TOKEN[0].STR[1] == '$'))
   {
   (void) strcpy(TOKEN[0].STR,&TOKEN[0].STR[1]);
   TOKEN[0].LEN --;
   return (0);                  /* pass unchanged to host system */
   }

	
/*  look for variables {XX} or {XX{YY}} for nested replacements  */
 
start = 0;
 
sub_loop:							/*
---------							*/
parno = 0;

for (n=start; n<MONIT.COUNT; n++)
   {
   escapa = 0;
 
sect_2100: 			    /* look recursively for nested variables */
   kk = CGN_INDEXC(TOKEN[n].STR,'{');
   if (kk >= 0) 		      /* if { found, look for last nestings */
      {
      if ((kk > 0) && (TOKEN[n].STR[kk-1] == '\\'))	/* escape char. */
         {
         TOKEN[n].STR[kk] = ',';	/* replace '\{' by '\,'  */
         escapa  = 1;
         goto sect_2100;	
         }

      start = n;			/* save no. of first modified token  */
 
sect_2200:
      nn = CGN_INDEXC(&TOKEN[n].STR[kk+1],'{');
         
      if (nn >= 0)
         {
         mm = nn + kk + 1;		/* absolute index in STR */
         if ( (nn > 0) && (TOKEN[n].STR[mm-1] == '\\') )
            {
            TOKEN[n].STR[mm] = ',';	/* replace '\{' by '\,'  */
            escapa  = 1;
            }
	 else
            kk += (nn + 1);
         goto sect_2200;			/* loop...  */
         }
 
      (void) strcpy(wbuf,&TOKEN[n].STR[kk+1]);
sect_2220:
      if ((lsave = CGN_INDEXC(wbuf,'}')) < 0) goto sect_2500;
      if (wbuf[lsave-1] == '\\')
         {
         wbuf[lsave] = '.';	/* replace '\}' by '\.'  */
         escapa = 1;
         goto sect_2220;
         }

      mm = kk + lsave + 2;	      /* save offset after variable  */
      left = TOKEN[n].LEN - mm;		/* remaining chars. in STR */
	
      stat = REPLACE(wbuf,&lsave,MAX_TOKEN);	/* replace variable  */
      if (stat > 0 )
         expand = 1;
      else if (stat < 0)
         {
         if (ERRORS.SYS == 0) ERRORS.SYS = 5;
         goto error_ret;
         }

      TOKEN[n].LEN = kk + lsave + left;
      if (TOKEN[n].LEN > MAX_TOKEN) 
         {
         for (nr=lsave-1; nr>=0; nr--)	/* cut off trailing blanks */
            {
            if (wbuf[nr] != ' ') break;
            }
         wbuf[++nr] = '\0';
         lsave = nr;
         TOKEN[n].LEN = kk + lsave + left;

         if (TOKEN[n].LEN > MAX_TOKEN) 		/* substitution too long */
            {
            (void) strcpy(&wbuf[lsave],&TOKEN[n].STR[mm]);
            mm = MAX_TOKEN - kk;
            (void) strncpy(&TOKEN[n].STR[kk],wbuf,mm);
            TOKEN[n].STR[MAX_TOKEN] = '\0';
            TOKEN[n].LEN = MAX_TOKEN;
            SCTSYS
                   ("Substring too long after substitution...truncated to:");
            SCTSYS(TOKEN[n].STR); 
            parno = 1;
            goto sect_2100;
            }
         }
 
      (void) strcpy(&wbuf[lsave],&TOKEN[n].STR[mm]);
      (void) strcpy(&TOKEN[n].STR[kk],wbuf);
      parno = 1;
      goto sect_2100;
      }
	
sect_2500:
   if (KIWORDS[OFF_MODE+3] == 1) goto sect_3000;

   /* if MODE(4) = 0, check also 'variables' (for backwards compatibility)  */

   kk = CGN_INDEXC(TOKEN[n].STR,'\'');	
   if (kk >= 0) 
      {
      start = n;			/* save no. of first modified token  */
      (void) strcpy(wbuf,&TOKEN[n].STR[kk+1]);
      if ((lsave = CGN_INDEXC(wbuf,'\'')) < 0) goto sect_3000;

      mm = kk + lsave + 2;		      /* save offset after variable  */
      left = TOKEN[n].LEN - mm;		/* remaining chars. in STR */
 
      stat = REPLACE(wbuf,&lsave,MAX_TOKEN);         /* replace variable */
      if (stat > 0 )
         expand = 1;
      else if (stat < 0)
         {
         ERRORS.SYS = 5;
         goto error_ret;
         }
 
      TOKEN[n].LEN = kk + lsave + left;
      if (TOKEN[n].LEN > MAX_TOKEN) 
         {
         for (nr=lsave-1; nr>=0; nr--)		/* cut off trailing blanks */
            {
            if (wbuf[nr] != ' ') break;
            }
         wbuf[++nr] = '\0';
         lsave = nr;
         TOKEN[n].LEN = kk + lsave + left;
         if (TOKEN[n].LEN > MAX_TOKEN)		/* substitution too long */
            {
            (void) strcpy(&wbuf[lsave],&TOKEN[n].STR[mm]);
            mm = MAX_TOKEN - kk;
            (void) strncpy(&TOKEN[n].STR[kk],wbuf,mm);
            TOKEN[n].STR[MAX_TOKEN] = '\0';
            TOKEN[n].LEN = MAX_TOKEN;
            SCTSYS
                   ("Substring too long after substitution...truncated to:");
            SCTSYS(TOKEN[n].STR);
            parno = 1;
            goto sect_2500;
            }
         }

      (void) strcpy(&wbuf[lsave],&TOKEN[n].STR[mm]);
      (void) strcpy(&TOKEN[n].STR[kk],wbuf);
      parno = 1;
      goto sect_2500;				/* loop until all is done  */
      }
	
sect_3000:
   if (escapa == 1)
      {
      for (nr=0; nr<TOKEN[n].LEN; nr++)
         {
         if (TOKEN[n].STR[nr] == '\\')
            {
            kk = nr + 1;
            if (TOKEN[n].STR[kk] == ',')
               TOKEN[n].STR[kk] = '{';
            else if (TOKEN[n].STR[kk] == '.')
               TOKEN[n].STR[kk] = '}';
            }
         }
      }
   }
	

/*  iterate until no more variables found   */
 
if (parno != 0)
   {
   if (++substi < 50) goto sub_loop;		/* avoid infinite loop...  */
   }


/*  if replacements took place, log new line  */
 
if (substi > 0)
   {
   LINE.LEN = TOKBLD(0,LINE.STR,MAX_LINE,1,MONIT.COUNT);
   if (LINE.LEN < 0) 
      {
      n = 0;
      ERRORS.SYS = 27;
      goto error_ret;
      }
 
   if (expand > 0) 
      {
      start = 0;			/* do it again with new line */
      goto parsing_loop;
      }

   if (parsecho == 2) ECHO_line(LINE.STR,LINE.LEN,-1);


   /* finally, check if replacing introduced  >file or >>file */

   n = MONIT.COUNT - 1;
   if ((TOKEN[n].STR[0] == '>') && (n > 0))
      {
      register char sngc;

      sngc = TOKEN[n].STR[1];
      if (sngc == '>') sngc = TOKEN[n].STR[2];
      if ( (sngc != '\0') && (sngc != ',') && (sngc != ':') &&
           (sngc != ']')  && (sngc != ' ') && (sngc != ')') &&
           (sngc != ';') )
         goto first_line;		/* do it all over again */
      }
   }

	
/*   that's it folks...    */
 
return (0);
 

/* error section  */

error_ret:
PREPERR("MIDAS",LINE.STR,TOKEN[n].STR);
return (ERRORS.SYS);
}

/*

*/
 
int SAVE_PARM(flag,level,pindx)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  replace formal parameters (P1, P2,...,P8) by their actual values
  and store them in keys P1,...P8,
  also store no. of passed parameters and their lengths into key PCOUNT
.ALGORITHM
  read actually passed parameter values from CODE(OFF_CODE+2:) on
  and replace formal parameters
  finally crosscheck against default values stored in CODE(OFF_CODE+201:)
.RETURNS
  stat:	  long int 	return status, 0 = o.k. ,else trouble...
------------------------------------------------------------------*/

int   flag;     /* IN: 1, we have to cross reference the parameters  \
		            2, just normal saving (parameters are already \
			       stored where they should)                 */
int   level;    /* IN: procedure level */
int   *pindx;   /* OUT: index to beginning of code (PC of MYBATCH) */
 
{
int   k1, k2, n, mm, stat;
int   offset, parno, d1, d2;

register int  loopn, loopm;
	
char  croslab[20];			/* synchronize with CROSS[].LABEL */
char	*pointr, *pntra, *tmppntr, *tmqpntr;
 
 
/*  init offsets  */
 
k1 = 1;			/* actual pars stored in CODE.CODE[1-CODE_DEFS]  */
d1 = CODE_DEFS;		/* start of default values */
	
if (flag == 1) 
   { 

   /* --- this is the cross reference section --- */
 
   tmqpntr = (char *) &CODE.WORK[250];	/* use work buffer [2000 - 2100] */
   *pindx = CODE_START;
   pointr = CODE.CODE+CODE_START;
   if ( (*pointr == '*') && (*(pointr+1) == 'C') )    /* CROSSREF command ? */
      {
      mm = CGN_INDEXC(pointr,'\r');		/* yes, find end of com line */
      *pindx += (mm+1);				/* update Program Counter  */

      CGN_UPCOPY(LINE.STR,pointr,mm);	    /* copy to LINE.STR in uppercase */
      LINE.STR[mm] = '\0';
      LINE.LEN = mm;
 
      stat = PARSE(2,0,0);
      if (stat != 0) return (stat);

 
   /* now solve user defined cross references  */
 
      for (loopn=1; loopn<MONIT.COUNT; loopn++)	 /* outer loop thru tokens */
         {
         if (TOKEN[loopn].LEN > 19) 
            return 5;		    /* labels cannot be longer than 19 chars */
	
         for (loopm=0; loopm<MONIT.CROSS_COUNT; loopm++)
            {				     /* inner loop through CROSSPARM */
            CGN_UPCOPY(croslab,CROSS[loopm].LABEL,20);
            				     /* use minimum matching */
            if (CGN_INDEXS(TOKEN[loopn].STR,croslab) == 0)
               {
               CROSS[loopm].NO = loopn - 1;
               break;
               }
            }
         ;
         }
      }
 
	
  /*  rebuild original parameter string   */
 
   for (loopm=0; loopm<MONIT.CROSS_COUNT; loopm++)
      {
      if (CROSS[loopm].NO < 0)  	
         {
         tmppntr = tmqpntr;
         mm = CGN_COPY(tmppntr,CROSS[loopm].LABEL);
         tmppntr += mm ;
         *tmppntr++ = '=' ;
         (void) strcpy(tmppntr,CROSS[loopm].PARM);
         (void) strcpy(CROSS[loopm].PARM,tmqpntr);
         CROSS[loopm].NO = loopm;
         }
      }
	
/*  everything looks o.k.,
    so now we can store the parameters in the right position  */
	
   for (parno=0; parno<8; parno++)
      {
      d2 = CGN_INDEXC(&CODE.CODE[d1],'\r');	/* move through defaults  */
      for (loopm=0; loopm<MONIT.CROSS_COUNT;loopm++)
         {			       /* this takes care of CROSS_COUNT = 0 */
         if (CROSS[loopm].NO == parno)
            {
            pointr = CROSS[loopm].PARM;
            if ( (*pointr == '?') && (*(pointr+1) == '\0') )
               goto sect_500;			/* interspersed default par. */
            else
               {
               mm = (int) strlen(CROSS[loopm].PARM);
               k2 = k1 + mm + 1;
               (void) strcpy(&CODE.CODE[k1],pointr);
               CODE.CODE[k1+mm] = '\r';
               CODE.CODE[k1+mm+1] = '\r';
               goto sect_600;
               }
            }
         }
 
	
/*  here we use the default values   */
 
sect_500:
      pointr = CODE.CODE+d1;
      mm = d2;
      k2 = k1 + 2;
      CODE.CODE[k1++] = '?';
      CODE.CODE[k1++] = '\r';
      CODE.CODE[k1] = '\r';
      /*
      (void) strncpy(&CODE.CODE[k1],"?\r\r",3);
      */
	
sect_600:
      k1 = k2;
      offset = MONIT.POFF[parno];		/* get offset of key Pi  */
      pntra = &KCWORDS[offset];
      CGN_FILL(pntra,' ',MAX_TOKEN);		/* first clear Pi  */
      (void) memcpy(pntra,pointr,(size_t)mm);	/* then fill keyword Pi  */
      KIWORDS[OFF_PCOUNT+parno+1] = mm;	  /* save also length of parameters */
 
      d1 += (d2 + 1);
      }
 
   if (k1 >= CODE_DEFZ) return (27);	     /* check for parameter overflow */
   
   CODE.CODE[k1+1] = '\0';
   } 


/* --- this is the "normal" section --- */

else
   {
   for (parno=0; parno<8; parno++)
      {
      k2 = CGN_INDEXC(&CODE.CODE[k1],'\r');	     /* look for end marker  */
      d2 = CGN_INDEXC(&CODE.CODE[d1],'\r');	/* look for end in defaults  */
      if ( (CODE.CODE[k1] == '?') &&
           (CODE.CODE[k1+1] == '\r') )		/* default value required ?  */
         {
         n = d1;
         mm = d2;				/* yes.  */
         }
      else
         {
         n = k1;
         mm = k2;				/* no.   */
         }
 
      if (mm > MAX_TOKEN) return (5);		/* something wrong ...  */
	
      offset = MONIT.POFF[parno];		/* get offset of key Pi */
      pntra = &KCWORDS[offset];
      CGN_FILL(pntra,' ',MAX_TOKEN);
      (void) memcpy(pntra,(CODE.CODE+n),(size_t)mm);	/* fill keyword Pi  */
      KIWORDS[OFF_PCOUNT+parno+1] = mm;	   /* save also length of parameters */
	
      k1 += (k2 + 1);
      d1 += (d2 + 1);
      }
   } 

	
/*  finally retrieve also no. of parameters   */
 
for (loopn=0; loopn<9; loopn++)
   {
   if (*CODE.CODE == asci[loopn])	/* convert ASCII no. to binary no.  */
      {
      KIWORDS[OFF_PCOUNT] = loopn;
      break;
      }
   }
	
return (0);
}
  
/*

*/
 
void CROSS_PARM()

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  fill up structure CROSS
.ALGORITHM
  look for LABEL=PARAM
.RETURNS
  nothing
---------------------------------------------------------------*/

{
int   mm, n2;
register int  loopn, loopm;
	
register char   *qfix, cdum; 
	



/*  number of passed parameters = COUNT - 2  */
 
MONIT.CROSS_COUNT = MONIT.COUNT - 2;
if (MONIT.CROSS_COUNT <= 0) return;
 
	
/*  fill up CROSSPARM table with labels in CROSS[n].LABEL
    and params in CROSS[n].PARM                                        */
 
for (loopn=2; loopn<MONIT.COUNT; loopn++)
   {
   n2 = loopn - 2;
   mm = CGN_INDEXC(TOKEN[loopn].STR,'=');
 
   if ( (mm > 0) && (mm < 20) )			/* LABEL length < 20 */
      {
      (void) memcpy(CROSS[n2].LABEL,TOKEN[loopn].STR,(size_t)mm);
      CROSS[n2].LABEL[mm] = '\0';
      (void) strcpy(CROSS[n2].PARM,&TOKEN[loopn].STR[mm+1]);

	
/*  take care of P1=...    */
 
      if (mm == 2) 
         {
         qfix = &asci[1];
         cdum = CROSS[n2].LABEL[0];
         if ( (cdum == 'P') || (cdum == 'p') )
            {
            for (loopm=0; loopm<8; loopm++)	      /* look for P1,P2,...  */
                {	
                if (CROSS[n2].LABEL[1] == *qfix)
                   {
                   CROSS[n2].LABEL[0] = 'P';	/* ensure, it's upper case */
                   CROSS[n2].NO = loopm;
                   goto end_loop;
                   }
                qfix ++;
                }
	     }
	 }
      CROSS[n2].NO = -1;
      }
   else
      {			/*  here the "normal" parameter mode  (mm < 0)  */
      CROSS[n2].LABEL[0] = 'P';
      CROSS[n2].LABEL[1] = asci[n2+1];
      CROSS[n2].LABEL[2] = '\0';
      mm = 0;
      for (loopm=0; loopm<TOKEN[loopn].LEN; loopm++) 
         {
         if (TOKEN[loopn].STR[loopm] != ' ')	/* skip leading blanks */
            {
            mm = loopm;
            break;
            }
         }

      (void) strcpy(CROSS[n2].PARM,&TOKEN[loopn].STR[mm]);
      CROSS[n2].NO = n2;
      }

end_loop:
   ;
   }
}
  
/*

*/
 
void CLEAR_LOCAL(level)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  1) modify KEY_LOCNO + KEY_LOCEND such that all local keywords at current 
     level vanish
  2) clear up table with mapped frames
.ALGORITHM
  straight forward
  has to be synchronized with MID_DEFKEY,MID_FNDKEY
.RETURNS
  nothing
------------------------------------------------------------*/

int   level  /* IN: current procedure level  */;

{
register int nr;

struct KEY_STRUCT *keypntr;

char    kc, lnow, lknow;
static char   clevel[MAX_LEVEL+4] = "ABCDEFGHIJKLMNOPQRSTUVWXY";
static char   klevel[MAX_LEVEL+4] = "abcdefghijklmnopqrstuvwxy";



/* if level = 1, we clear up completely...  */

MONIT.MXT[level] = 0;
if (level <= 1)
   {
   KEYALL.LOCNO = KEYALL.GLOBENT-1;
   KEYALL.LOCEND = KEYALL.GLOBDAT-1;
   return;
   }

else if (KEYALL.LOCNO < KEYALL.GLOBENT)
   return;	  	      		/* no local keys exist...  */

else
   {
   lnow = clevel[level-1];
   lknow = klevel[level-1];

   keypntr = KEYALL.KEYNAMES + KEYALL.LOCNO;
   for (nr=KEYALL.LOCNO; nr>=KEYALL.GLOBENT; nr--)
      {
      kc = keypntr->IDENT[16];
      if ( (kc != lnow) && (kc != lknow) )
         break;
      else
         {
         KEYALL.LOCNO --;
         KEYALL.LOCEND -= (keypntr->FRPAD + keypntr->LEN);
         }
      keypntr --;
      }
   }
}

/*

*/

void LOG_line(cptr,lc)
char  *cptr;
int   lc;

{
int  ia, plend;

#ifndef NO_READLINE
add_history(cptr);
#endif

plend = FRONT.PEND + 5;
(void) memcpy(logstrng,FRONT.PROMPT,(size_t)plend);

ia = MAX_LINE - plend;                        /* max. we can fit */
if (lc >= ia) lc = ia - 1;
(void) memcpy(&logstrng[plend],cptr,(size_t)lc);
lc += plend;
logstrng[lc] = '\0';   
(void) MID_LOG('G',logstrng,lc);
}

/*

*/

int CATALO(option,ity)
char  option, ity;

{
int   iflag, fid, ct, e_c, e_l;
int   n, ll, begin, kcount, stat;
register int nr;
 
float   rdum;
double  ddum;

char	ident[80];
char	catfile[84], output[84];
char	cbuf[80];
char    cclow[80], cchi[80];
static char  blank[] = "     ";                         /* 5 blanks (+ \0) */




	

kcount = 0;
ct = 0;
(void) memcpy(catfile,TOKEN[1].STR,(size_t)(TOKEN[1].LEN+1));


/* find out, if we get input from dirfile.ascii or key INPUTC */

if ((MONIT.COUNT > 3) && (option =='A'))
   {
   (void) memcpy(cclow,TOKEN[3].STR,(size_t)(TOKEN[3].LEN+1));
   nr = CGN_INDEXC(cclow,',');
   if (nr < 0) 
      ct = 1;				/* only low test  */
   else if (nr == (TOKEN[3].LEN-1))	/* `xyz,' => only low test */
      {
      ct = 1;
      cclow[nr] = '\0';
      }
   else if (nr == 0)
      {
      (void) strcpy(cchi,&cclow[1]);
      ct = 2;				/* only high test  */
      }
   else
      {
      cclow[nr++] = '\0';
      (void) strcpy(cchi,&cclow[nr]);
      ct = 3;				/* low + high test  */
      }
   }

iflag = 0;
begin = 0;
ll = TOKEN[2].LEN;

nr = CGN_INDEXC(TOKEN[2].STR,'*');
if (nr > (-1))
   {
#if vms
   (void) sprintf(cbuf,"$ DIREC/SIZE/OUT=dirfile.ascii %s",TOKEN[2].STR);
   RUN_IT(cbuf);		/* don't know if VMS also has `system()' */
#else
   (void) sprintf(cbuf,"ls %s > dirfile.ascii",TOKEN[2].STR);
   (void) system(cbuf);
#endif

   fid = osaopen("dirfile.ascii",READ);   /* input from dirfile.ascii */
   if (fid < 0) return 3;

   iflag = 1;
   }

else 
   {
   nr = ll - 4;				/* point to a possible ".cat" */
   if (strcmp(&TOKEN[2].STR[nr],".cat") == 0)
      {
      fid = osaopen(TOKEN[2].STR,READ);   /* input from catalog */
      if (fid < 0) return 3;

      stat = osaread(fid,cbuf,80);		/* skip info line */
      if (stat < 0) goto file_end; 		/* EOF reached */

      iflag = 1;
      }
   }

e_c = ERRO_CONT;			/* continue on errors  */
e_l = ERRO_LOG;
ERRO_CONT = 1;
ERRO_LOG = 0;

add_loop:
if (iflag == 1)
   {
   stat = osaread(fid,cbuf,80);
   if (stat < 0) goto file_end;			/* EOF reached */

   ll = CGN_INDEXC(cbuf,' ');			/* isolate filename */
   if (ll > 0) cbuf[ll] = '\0';

#if vms
   ll = CGN_INDEXC(cbuf,FSY_TYPMARK);		/* find file type */
   n = CGN_INDEXC(&cbuf[ll],';');		/* and file version */
   if (n >= 0) cbuf[ll+n] = '\0';
#endif

   }
else
   {
   stat = CGN_EXTRSS(TOKEN[2].STR,ll,',',&begin,ident,80);
   if (stat <= 0) goto file_end;

   /*  check, if it's a #xyz name   */

   if (ident[0] == '#')
      {
      stat = CGN_CNVT(&ident[1],1,1,&ll,&rdum,&ddum);
      if (stat != 1)
         {
         (void) sprintf(output,"invalid catalog entry no %s ...",ident);
         SCTPUT(output);
         goto add_loop;
         }
      
      stat = SCCFND(catfile,ll,cbuf);
      if (stat != ERR_NORMAL)
         {
         (void) sprintf(output,"catalog entry no %d not found ...",ll);
         SCTPUT(output);
         goto add_loop;
         }
      }
   else
      CGN_CLEANF(ident,ity,cbuf,80,&n,&n);
   }


/* for ADD/xCAT check name against cclow, cchi  */

if (option == 'A')
   {
   if ((ct == 1) || (ct == 3))
      {
      n = strcmp(cclow,cbuf);
      if (n > 0) goto add_loop;
      }
   if ((ct == 2) || (ct == 3))
      {
      n = strcmp(cchi,cbuf);
      if (n < 0) goto add_loop;
      }

   if (ity != F_ASC_TYPE)
      stat = SCCADD(catfile,cbuf,blank);
   else
      stat = SCCADD(catfile,cbuf,"ASCII file ");
   }
else
   stat = SCCSUB(catfile,cbuf);

if (stat == ERR_NORMAL) kcount ++;
goto add_loop;					/* look for more  */


file_end:
/*
if (iflag == 1) osaclose(fid);
*/

if (kcount > 1)
   (void) strcpy(ident,"entries");
else
   (void) strcpy(ident,"entry");
if (option == 'A')
   (void) sprintf
   (output,"%d %s added/updated for catalog %s",kcount,ident,catfile);
else
  (void) sprintf
   (output,"%d %s subtracted from catalog %s",kcount,ident,catfile);
SCTPUT(output);

ERRO_CONT = e_c;
ERRO_LOG = e_l;

return 0;
}

/*

*/
 
int DSC_write()

{
int   entrx, first, bytelem, noelem, unit;
int   stat, nn, start, slen;
int   errflg, allflag;
int   cnvno, *ibuf, iall;
register int  nr, mr;
static int  work_size = 0;
	
char	k_type[4], type[16], cc[4], descr[52], *cbuf, substr[24];
char	*xbuf, *ybuf;
register char cr;
static char  *work_str;
 
float	*rbuf, rall;
	
double	*dbuf, dall;


 
 

/* open file */

(void) FRAMACC('O',TOKEN[1].STR,0,&entrx);	/* open image or table */
if (entrx < 0) 
   {
   ERRORS.SYS = 44;			/* could not open */
   errflg = 1;				/* TOKEN[1].STR */
   goto errors;
   }


/* set ALLflag */

cr = TOKEN[4].STR[0];
if ((cr == 'A') || (cr == 'a'))
   allflag = 1;
else 
   allflag = 0;


if (work_size == 0)
   {
   work_size = 800;		/* start with buffer for 800 chars.  */
   work_str = malloc((unsigned int)work_size);
   }
dbuf = (double *)work_str;
ibuf = (int *)work_str;
rbuf = (float *)work_str;
cbuf = work_str;
ERRO_LOG = 1;				/* save lower level errors ... */ 

 

(void) memcpy(descr,TOKEN[2].STR,(size_t)(TOKEN[2].LEN+1));
slen = CGN_INDEXC(descr,'/');		/* test, if default is taken */

 
/*  handle default or specific key specs  */
 
errflg = 2;				/* default error_str to 3. token  */
ERRORS.SYS = 85;				/* default to invalid syntax  */

if (slen < 1)  				/* yes - all defaults  */
   {
   if (SCDFND(entrx,descr,k_type,&noelem,&bytelem) != ERR_NORMAL)
      goto errors;				/* wrong syntax...   */
 
   first = 1;
   if ( (k_type[0] == 'C') && (bytelem > 1) )
      (void) sprintf(type,"C*%d",bytelem);
   else
      {
      type[0] = k_type[0];
      type[1] = '\0';
      }
   }

else				    /* no. we have to extract everything...  */
   {
   descr[slen] = '\0';
   start = slen + 1;
   slen = CGN_EXTRSS(descr,TOKEN[2].LEN,'/',&start,type,15);
   MID_TYPCHK(type,cc,&nn);
   if (cc[0] == ' ') 
      {
      if ((type[0] == 'L') || (type[0] == 'l'))
         {
         cc[0] = 'L';			/* logical treated as integer */
         nn = II_SIZE;
         }
      else if ((type[0] == 'H') || (type[0] == 'h'))
         {
         cc[0] = 'H';
         nn = 1;
         }
      else
         goto errors;
      }
 
   type[0] = cc[0];
   bytelem = nn;
   slen = CGN_EXTRSS(descr,TOKEN[2].LEN,'/',&start,substr,20);
   if (slen > 0) 
      {
      first = -99;
      first = atoi(substr);
      if (first < (-1)) goto errors;
      slen = CGN_EXTRSS(descr,TOKEN[2].LEN,'/',&start,substr,20);
      }
   else
      goto errors;

   noelem = -99;
   noelem = atoi(substr);
   if (noelem < 1) goto errors;
 
   } 
	
 
 
/*  convert to binary if it's not a character descr  */
 

errflg = 3;
ERRORS.SYS = 100;
stat = ERR_INPINV;

if (type[0] == 'I')
   {
   if (allflag == 1)
      {
      cnvno = CGN_CNVT(TOKEN[3].STR,1,1,&iall,rbuf,dbuf);
      if (cnvno < 1) goto errors;
 
      nn = noelem * II_SIZE;
      if (nn > work_size)
         {
         free(work_str);               /* free old memory + allocate new one */
         work_size = nn;
         work_str = malloc((unsigned int)work_size);
         ibuf = (int *) work_str;
         }
      for (nr=0; nr<noelem; nr++)
         *(ibuf+nr) = iall;
      cnvno = noelem;
      }
   else
      cnvno = CGN_CNVT(TOKEN[3].STR,1,noelem,ibuf,rbuf,dbuf);
   
   if (cnvno > 0) stat = SCDWRI(entrx,descr,ibuf,first,cnvno,&unit);
   }

else if (type[0] == 'R')
   {
   if (allflag == 1)
      {
      cnvno = CGN_CNVT(TOKEN[3].STR,2,1,ibuf,&rall,dbuf);
      if (cnvno < 1) goto errors;
 
      nn = noelem * RR_SIZE;
      if (nn > work_size)
         {
         free(work_str);               /* free old memory + allocate new one */
         work_size = nn;
         work_str = malloc((unsigned int)work_size);
         rbuf = (float *) work_str;
         }
      for (nr=0; nr<noelem; nr++)
         *(rbuf+nr) = rall;
      cnvno = noelem;
      }
   else
      cnvno = CGN_CNVT(TOKEN[3].STR,2,noelem,ibuf,rbuf,dbuf);
   
   if (cnvno > 0) stat = SCDWRR(entrx,descr,rbuf,first,cnvno,&unit);
   }

else if (type[0] == 'D')
   {
   if (allflag == 1)
      {
      cnvno = CGN_CNVT(TOKEN[3].STR,4,1,ibuf,rbuf,&dall);
      if (cnvno < 1) goto errors;
 
      nn = noelem * DD_SIZE;
      if (nn > work_size)
         {
         free(work_str);               /* free old memory + allocate new one */
         work_size = nn;
         work_str = malloc((unsigned int)work_size);
         dbuf = (double *) work_str;
         }
      for (nr=0; nr<noelem; nr++)
         *(dbuf+nr) = dall;
      cnvno = noelem;
      }
   else
      cnvno = CGN_CNVT(TOKEN[3].STR,4,noelem,ibuf,rbuf,dbuf);
   
   if (cnvno > 0) stat = SCDWRD(entrx,descr,dbuf,first,cnvno,&unit);
   }

else if ((type[0] == 'C') || (type[0] == 'H'))
   { 
   nn = noelem * bytelem;			/* total size */
   if ((nn +2) > work_size)
      {
      free(work_str);		/* free old memory + allocate new one */
      work_size = nn + 2;	/* add space for '\0'  */
      work_str = malloc((unsigned int)work_size);
      cbuf = work_str;
      }

   slen = TOKEN[3].LEN;
   (void) memcpy(cbuf,TOKEN[3].STR,slen+1);

   if (KIWORDS[OFF_AUX+4] == 0)
      {
      if ((*cbuf == '"') && (*(cbuf+slen-1) == '"'))
         {				/* drop the enclosing quotes */
         cbuf ++;
         slen -= 2;
         *(cbuf+slen) = '\0';
         }
      }

   if (bytelem == 1)			/* flat char. string */
      {
      if (allflag == 1)
         {					/* handle ALL option ...  */
         cr = *cbuf;
         xbuf = cbuf+1;
         for (nr=1; nr<noelem; nr++) *xbuf++ = cr;
         }
      else
         {
         if (noelem > slen) 
            {
            CGN_FILL(cbuf+slen,' ',(noelem-slen));
            *(cbuf+noelem) = '\0';
            }
         }
      if (type[0] == 'C')
         stat = SCDWRC(entrx,descr,1,cbuf,first,noelem,&unit);
      else
         stat = SCDWRH(entrx,descr,cbuf,first,noelem);
      }
   else
      {
      if (allflag == 1)
         {					/* handle ALL option ...  */
         xbuf = cbuf + slen;
         for (nr=slen; nr<bytelem; nr++)	/* fill up 1st element */
            *xbuf++ = ' ';
         for (nr=1; nr<noelem; nr++) 
            {
            xbuf = cbuf;
            ybuf = cbuf + (nr *bytelem);
            for (mr=0; mr<bytelem; mr++) *ybuf++ = *xbuf++;
            }
         }
      else
         {
         if (nn > (slen*bytelem)) 
            {
            CGN_FILL(cbuf+slen,' ',(nn-slen));
            *(cbuf+nn) = '\0';
            }
         }
      stat = SCDWRC(entrx,descr,bytelem,cbuf,first,noelem,&unit);
      }
   }

else	/*  here we work on logical arrays   */
   {
   cr = TOKEN[3].STR[0];

   if (allflag == 1)
      {
      nn = noelem * II_SIZE;
      if (nn > work_size)
         {
         free(work_str);               /* free old memory + allocate new one */
         work_size = nn;
         work_str = malloc((unsigned int)work_size);
         ibuf = (int *) work_str;
         }

      if ((cr == 'T') || (cr == 't'))
         iall = 1;
      else if ((cr == 'F') || (cr == 'f'))
         iall = 0;
      else
         {
         cnvno = CGN_CNVT(TOKEN[3].STR,1,1,&iall,rbuf,dbuf);
         if (cnvno < 1) goto errors;
         }
 
      for (nr=0; nr<noelem; nr++)
         *(ibuf+nr) = iall;
      cnvno = noelem;
      }
   else
      {
      cnvno = 1;
      if ((cr == 'T') || (cr == 't'))
         *ibuf = 1;
      else if ((cr == 'F') || (cr == 'f'))
         *ibuf = 0;
      else 
         cnvno = CGN_CNVT(TOKEN[3].STR,1,noelem,ibuf,rbuf,dbuf);
      }
  
   if (cnvno > 0) stat = SCDWRL(entrx,descr,ibuf,first,cnvno,&unit);
   }


if (stat < 1)				/* that ignores warnings... */
   {
   ERRO_LOG = 0;
   ERRO_INDX = -1;
   return (0);
   }



/*  here, if something went wrong...   */

errors:
ERRORS.STATUS = stat;
(void) strcpy(cbuf,TOKEN[errflg].STR);

PREPERR("MIDAS",LINE.STR,cbuf);
ERRO_LOG = 0;
ERRO_INDX = -1;

return (1);
}