/*===========================================================================
  Copyright (C) 1995-2011 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 PREPE +++++++++++++++++++++++
.LANGUAGE  C
.IDENTIFICATION  Module PREPE
.AUTHOR  K. Banse			ESO - Garching
.KEYWORDS
MIDAs monitor
.COMMENTS
holds COMPILE, PARDEFS, SETMID, disp_midvals
.VERSION  [1.00] 870723: from FORTRAN version 3.90  as of  870311

 110221		last modif
---------------------------------------------------------------------------*/

#include <fileexts.h>

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

#include <string.h>
#include <stdlib.h>


#define DEF_LIM 20
#define DO_NESTLIM 7
#define IF_NESTLIM 9

struct DEF_STRUCT
   {
   char		COMQUAL[10];
   char		STR[82];
   int          COUNT;
   };
struct DEF_STRUCT  *defpntr;

struct DEF_ALL
   {
   int          MAX;
   int          LAST;
   struct DEF_STRUCT  *PNTR;
   char		*BYTES;
   };
struct DEF_ALL DEFAULTS;

int  IDI_SINI(), IDI_SCLS(), IISSIN_C();


/*

*/

int COMPILE(comflg,offset)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  compile the strcutural commands like IF ... THEN ... ELSE IF ... ENDIF
.ALGORITHM
  painfully straightforward using just IFs, GOTOs and labels
.RETURN
 return status:  = 0, o.k.
                 > 0, compilation error
------------------------------------------------------------------------*/

int  comflg   /* IN: flag to indicate command to be compiled  */;
int  *offset  /* IO: pointer to current position within CODE.CODE \
                          or param. no. for DEFINE/PARAM      */;

{
int   k, klen, kk, mm, koff, myoff, parmno, n;
int   iwa, jj, ifcombi, nspf;
register int  nr;

static int   labl_count;			/* label generator */
static int   dodx, do_stack[8];
static int   ifdx, if_first[10], if_else[10], if_end[10];
	
char	cc, save[10], savdef[12];
char    *cpntr, *formpntr, *errpntr;
register char  c1, c2, c3, c4, *startptr, *codeptr;

static char   blank[4] = "   ";
static char   do_pntr[8][40];
static char   do_lim[8][40], do_step[8][40];
static char   asci[9] = {'0','1','2','3','4','5','6','7','8'};
static char   logop[24] = {'E','Q','N','E','G','T','G','E','L','T','L','E',
                           'N','E','E','Q','L','E','L','T','G','E','G','T'};
float   rwa;

double  dwa;

/*

comflg = 0 - IF, 1 - ELSE, 2 - ELSEIF, 3 - ENDIF, 4 - DO, 5 - ENDDO,
         6 - DEFINE, 7 - FORMAT, 8 - INIT, 9 - FINISH

*/

	

jj = 0;

switch(comflg)			 /* branch according to action flag */
   {

   case 4:			/*  expand DO command 
   ---------------------------------------------------- */

   if (++dodx > DO_NESTLIM)  		/* increment DO nesting level */
      {
      ERRORS.SYS = 70;
      goto error_ret;
      }


   /*  save start, end + step of loop  */

   ERRORS.SYS = 71;
   for (n=3; n<6; n++)
      {
      if (TOKEN[n].LEN > 39) 		/* try to shorten */
         {
         klen = CGN_CNVT(TOKEN[n].STR,1,1,&iwa,&rwa,&dwa);
         if (klen != 1) goto error_ret;
         TOKEN[n].LEN = sprintf(TOKEN[n].STR,"%d",iwa);
         }
      }

   startptr = codeptr = CODE.CODE+(*offset);
   (void) memcpy(codeptr,TOKEN[1].STR,(size_t)TOKEN[1].LEN);
   codeptr += TOKEN[1].LEN;
   *codeptr++ = ' ';
   *codeptr++ = '=';
   *codeptr++ = ' ';
   (void) memcpy(codeptr,TOKEN[3].STR,(size_t)TOKEN[3].LEN);
   codeptr += TOKEN[3].LEN;
   do_stack[dodx] = labl_count++;
   nspf = sprintf(codeptr,"\r%6.6d:\r",do_stack[dodx]);
   jj = (int) (codeptr - startptr);
   *offset += (jj + nspf);


   /*  save necessary info in DO stacks  */

   (void) memcpy(do_pntr[dodx],TOKEN[1].STR,(size_t)(TOKEN[1].LEN+1));
   (void) memcpy(do_lim[dodx],TOKEN[4].STR,(size_t)(TOKEN[4].LEN+1));
   if (TOKEN[5].STR[0] == '?') 
      {
      do_step[dodx][0] = '1';			/* default step size is 1  */
      do_step[dodx][1] = '\0';
      }
   else
      (void) memcpy(do_step[dodx],TOKEN[5].STR,(size_t)(TOKEN[5].LEN+1));
   return (0);



   case 5:			/* expand ENDDO command
   ---------------------------------------------------- */

   if (dodx < 0) 
      {
      ERRORS.SYS = 72;
      goto error_ret;
      }
 
   startptr = codeptr = CODE.CODE+(*offset);
   *codeptr++ = '*';
   *codeptr++ = 'I';
   *codeptr++ = 'N';
   *codeptr++ = 'C';
   *codeptr++ = ' ';
   jj = CGN_COPY(codeptr,do_pntr[dodx]);
   codeptr += jj;					/* loop variable  */
   *codeptr++ = ' ';
   jj = CGN_COPY(codeptr,do_step[dodx]);
   codeptr += jj;					/* loop stepsize  */
   *codeptr++ = ' ';
   jj = CGN_COPY(codeptr,do_lim[dodx]);
   codeptr += jj;					/* loop limit  */
   nspf = sprintf(codeptr," %6.6d\r\r",do_stack[dodx]);
   jj = (int) (codeptr - startptr);
   *offset += (jj + nspf - 1); 		/* don't pass over second '\r'...  */
   dodx --;
   return (0);



   case 6:			/*  command DEFINE/PARAM
   ---------------------------------------------------- */
	
   myoff = CODE_DEFS;		/* start of default values for parameters */
   koff = 1;			/* start of actual values for parameters */
   cpntr = CODE.WORK3;		/* use buffer WORK3 of size 800 */

   parmno = *offset;			/* offset = parameter no. (1,2,...) */

   nr = parmno;
   while (nr > 1)	  	/* find place of corresponding default value */
      {
      mm = CGN_INDEXC(CODE.CODE+myoff,'\r');
      myoff += (mm + 1);
      mm = CGN_INDEXC(CODE.CODE+koff,'\r');
      koff += (mm + 1);
      nr --;
      }


   /* save following portion of defaults + repaste the whole thing again  */

   mm = CGN_INDEXC(CODE.CODE+myoff,'\r');	/* find end of curr. default */
   k = CODE_DEFS + CODE_DEFLEN;			/* last space for defaults */
   kk = myoff + mm;
   if (kk >= k)
      {
      printf("neg.length (k - kk) = %d\n",k-kk);
      }
   (void) memcpy(cpntr,CODE.CODE+kk,(size_t)(k-kk));
   (void) memcpy(CODE.CODE+myoff,TOKEN[2].STR,(size_t)TOKEN[2].LEN);
   myoff += TOKEN[2].LEN;
   if (myoff >= k) 			/* default overflow... */
      {
      ERRORS.SYS = 29;
      goto error_ret;
      }

   if (myoff >= k)
      {
      printf("neg.length (k - myoff) = %d\n",k-myoff);
      }
   (void) memcpy(CODE.CODE+myoff,cpntr,(size_t)(k-myoff));
   CODE.CODE[k] = '\r';		/* make sure we have a terminating \r  */

   c1 = *CODE.CODE;		/* update PCOUNT if parno. now higher */
   for (nr=0; nr<9; nr++)
      {
      if (c1 == asci[nr]) break;
      }

   if (parmno > nr)
      {
      *CODE.CODE = asci[parmno];
      KIWORDS[OFF_PCOUNT] = parmno;	
      }


   /*  if Pi not given, modify also keyword Pi (has length = MAX_TOKEN)  */

   mm = MONIT.POFF[parmno-1];		/* get offset for key Pi  */
   if ( (KCWORDS[mm] == '?') && (KCWORDS[mm+1] == ' ') )
      {
      memset((void *)(KCWORDS+mm),32,(size_t)MAX_TOKEN);
      (void) memcpy(KCWORDS+mm,TOKEN[2].STR,(size_t)TOKEN[2].LEN);
      KIWORDS[OFF_PCOUNT+parmno] = TOKEN[2].LEN;   /* save length in PCOUNT */
      }


  /*  if actual value was replaced, force to default choice  */

   if (CODE.CODE[koff] != '?')
      {
      mm = CGN_INDEXC(CODE.CODE+koff,'\r');
      mm += koff;
      CODE.CODE[koff++] = '?';			/* overwrite with remainder */
      CGN_strcpy(CODE.CODE+koff,CODE.CODE+mm);
      }

    return (0);



   case 7:				/* command FORMAT 
   ---------------------------------------------------- */

   n = 1;
   ERRORS.SYS = 19;
   formpntr = &PROC.FORMAT[MONIT.LEVEL*15];	/* point to Format strings */

format_check:
   ERRORS.INDEX = n;
   klen = TOKEN[n].LEN;
   jj = CGN_INDEXC(TOKEN[n].STR,',');
   if (jj > -1)			/* we have Fxx.yy,Fxx.yy */
      {
      iwa = 0;				/* specific format */
      if (jj == (klen-1))		/* ignore trailing `,' like F12.5, */
         {
         klen --;
         jj = -1;			/* reset flag */
         }
      else if (jj == 0)			/* ,Gxx.xx  for only double format */
         {
         (void) memmove(TOKEN[n].STR,&TOKEN[n].STR[1],(size_t)TOKEN[n].LEN);
         klen --;
         }
      else
         {
         TOKEN[n].STR[jj]= '\0';	/* isolate real format */
         klen = jj;
         }
      }
   else
      iwa = 1;				/* single format => real + double */

format_test:
   mm = 0;
   if ( (klen < 2) || (TOKEN[n].STR[klen-1] == '.') )
      return (ERRORS.SYS);		/*  '.' should not be last char. */

   for (k=1; k<klen; k++)		/* check format string */
      {
      c1 = TOKEN[n].STR[k];
      if (c1 == '.')
         {
         if ((k < 2) || (k > 3))
            return (ERRORS.SYS);
         else
            {
            if (++mm > 1) return (ERRORS.SYS);
            }
         }
      else 
         {
         if ((c1 < '0') || (c1 > '9')) return (ERRORS.SYS);
         }
      }

   c1 = TOKEN[n].STR[1];		/* reset to 1. char. */
   c3 = TOKEN[n].STR[0];
   if (c3 <= 'a') c3 += ('a' - 'A');

   if ((c3 == 'i') || (c3 == 'j'))
      {
      if ((jj != -1) ||
          (klen > 3) || (mm > 0)) 
         return (ERRORS.SYS);		/* I format without '.'  */

      cpntr = formpntr;			/* point to I-Format */
      *(cpntr+3) = ' ';			/* init last 2 chars. to ' '  */
      *(cpntr+4) = ' ';

      *cpntr++ = c1;
      if (c3 == 'i')
         cc = '.';
      else
         cc = ',';

      if (klen == 2)	
         {
         *cpntr++ = cc;
         *cpntr   = c1;
         }
      else 
         {
         c2 = TOKEN[n].STR[2];
         *cpntr++ = c2;
         *cpntr++ = cc;
         *cpntr++ = c1;
         *cpntr   = c2;
         }
      }

   else 
      {
      if (jj == 0)			/* is it a double format? */
         {
         jj = -1;
         cpntr = formpntr + 10;		/* point to format for double */
         }
      else
         cpntr = formpntr + 5;		/* point to format for real */

      if ( (klen > 6) || (TOKEN[n].STR[klen-1] == '.') || (mm == 0) )
         return (ERRORS.SYS);

      if (c3 == 'f')
         cc = ';';				/* F format */
      else if (c3 == 't')
         cc = ',';				/* like F format */
      else
         cc = '.';				/* default to G format */

      *(cpntr+4) = ' ';			/* init last char. to ' '  */

      *cpntr++ = c1;
      c2 = TOKEN[n].STR[2];
      c4 = TOKEN[n].STR[4];
      if (c2 == '.')
         {	
         *cpntr++ = cc;
         *cpntr++ = TOKEN[n].STR[3];
         if (klen < 5) 			/* Ga.c  */
            *cpntr = ' ';
         else 				/* Ga.cd */
            {
            if (*(cpntr-1) == '0')
               {
               *(cpntr-1) = c4;		/* Ga.0d => Ga.d */
               *cpntr = ' ';
               }
            else                           /* Ga.cd */
               *cpntr = c4;
            }
         }
      else
         {
         *cpntr++ = c2;
         *cpntr++ = cc;
         *cpntr++ = c4;			/* Gab.c  */
         if (klen == 6)				/* Gab.cd */
            {
            if (c4 == '0')
               *(cpntr-1) = TOKEN[n].STR[5];	/* Gab.0d => Gab.d */
            else 
               *cpntr = TOKEN[n].STR[5];
            }
         }
      
      if (jj > -1)		/* we also have to handle the double format */
         {
         klen = CGN_COPY(TOKEN[n].STR,&TOKEN[n].STR[jj+1]);
         jj = 0;
         goto format_test;
         }
      else if (iwa == 1)	/* format -> real + double */
         {
         jj = 0;
         iwa = 0;
         goto format_test;
         }
      }
   						/*  look for second format */
   if (TOKEN[++n].STR[0] != '?') goto format_check;

   return(0);
   
   

   case 0:			/*  expand IF ... THEN  command  
   ---------------------------------------------------- */
	
   if (++ifdx > IF_NESTLIM) 		     /* increment IF nesting level  */
      {
      ERRORS.SYS = 73;
      goto error_ret;
      }
   else
      {
      myoff = *offset;
      if_first[ifdx] = 0;
      if_end[ifdx] = if_else[ifdx] = labl_count; /* save label no. for ELSE */
    					  	 /* as well as for ENDIF  */
      goto sect_5050;
      }



   case 2:				/* here also ELSEIF joins 
   ---------------------------------------------------- */

sect_5040:
   myoff = *offset;
   if (if_first[ifdx] == 0)		/* but only if it's first time */
      {
      if_end[ifdx] = labl_count++;
      if_first[ifdx] = 1;
      }
   nspf = sprintf(CODE.CODE+myoff,"*GO %6.6d\r%6.6d:\r",
           if_end[ifdx],if_else[ifdx]);
   myoff += nspf;
   if_else[ifdx] = labl_count;

sect_5050:
   CGN_UPCOPY(savdef,TOKEN[2].STR,4);
   for (nr=0; nr<11; nr+=2)             /* get opposite logical operation  */
      {
      if ( (savdef[1] == logop[nr] ) && (savdef[2] == logop[nr+1] ) )
         {
         if ((savdef[0] == '.') && (savdef[3] == '.'))
            {
            savdef[1] = logop[nr+12];
            savdef[2] = logop[nr+13];
            savdef[4] = ' ';
            goto sect_5100;
            }
         }
      }
   errpntr = TOKEN[2].STR;
   ERRORS.SYS = 28;			/* invalid logical operation  */
   goto error_ret1;

	
sect_5100:
   (void) sprintf(save,"%6.6d\r",labl_count++);
   CODE.CODE[myoff++] = '*';
   CODE.CODE[myoff++] = 'I';
   CODE.CODE[myoff++] = 'F';
   CODE.CODE[myoff++] = ' ';
   (void) memcpy(CODE.CODE+myoff,TOKEN[1].STR,(size_t)TOKEN[1].LEN);
   myoff += TOKEN[1].LEN;
   CODE.CODE[myoff++] = ' ';
   (void) memcpy(CODE.CODE+myoff,savdef,(size_t)5);
   myoff += 5;
   (void) memcpy(CODE.CODE+myoff,TOKEN[3].STR,(size_t)TOKEN[3].LEN);
   myoff += TOKEN[3].LEN;
   CODE.CODE[myoff++] = ' ';
	

   /* check for ... .AND. ...  and for ... .OR. ...  */

   CGN_UPCOPY(savdef,TOKEN[4].STR,6);
   savdef[6] = '\0';
   if ( strcmp(savdef,".AND.") == 0 ) 
      {
      ifcombi = 1;
      (void) 
      memcpy(CODE.CODE+myoff,save,(size_t)7);	/* finish IF from above */
      myoff += 7;
      }
   else if ( strcmp(savdef,".OR.") == 0 )
      {						/* jump to following line */
      ifcombi = 2;
      jj = labl_count + 1;
      (void) sprintf(CODE.CODE+myoff,"%6.6d\r*GO %6.6d\r%6.6d:\r",
                     labl_count,jj,labl_count);
      labl_count += 2;
      myoff += 26;				/* write 3 CODE lines */
      }
   else
      {
      ifcombi = 0;
      (void) 
      memcpy(CODE.CODE+myoff,save,(size_t)7);	/* finish IF from above */
      myoff += 7;
      *offset = myoff;
      if (TOKEN[4].STR[0] == '?')
         {
         ERRORS.SYS = 5;
         goto error_ret;
         }
      if ( strcmp(savdef,"THEN") == 0 )		/* test for THEN */
         return (0);
      else
         {
         kk = 4;
         goto else_check;
         }
      }

   CGN_UPCOPY(savdef,TOKEN[6].STR,4);
   for (nr=0; nr<11; nr+=2)             /* get opposite logical operation  */
      {
      if ( (savdef[1] == logop[nr] ) && (savdef[2] == logop[nr+1] ) )
         {
         if ((savdef[0] == '.') && (savdef[3] == '.'))
            {
            savdef[1] = logop[nr+12];
            savdef[2] = logop[nr+13];
            savdef[4] = ' ';
            goto sect_5200;
            }
         }
      }
   ERRORS.SYS = 28;                         /* invalid logical operation  */
   errpntr = TOKEN[6].STR;
   goto error_ret1;

sect_5200:
   CODE.CODE[myoff++] = '*';
   CODE.CODE[myoff++] = 'I';
   CODE.CODE[myoff++] = 'F';
   CODE.CODE[myoff++] = ' ';
   (void) memcpy(CODE.CODE+myoff,TOKEN[5].STR,(size_t)TOKEN[5].LEN);
   myoff += TOKEN[5].LEN;
   CODE.CODE[myoff++] = ' ';
   (void) memcpy(CODE.CODE+myoff,savdef,(size_t)5);
   myoff += 5;
   (void) memcpy(CODE.CODE+myoff,TOKEN[7].STR,(size_t)TOKEN[7].LEN);
   myoff += TOKEN[7].LEN;
   CODE.CODE[myoff++] = ' ';
   (void) memcpy(CODE.CODE+myoff,save,(size_t)7);  /* use same target label */
   myoff += 7;

   if (TOKEN[8].STR[0] == '?')
      {
      ERRORS.SYS = 5;
      goto error_ret;
      }

   if (ifcombi == 2)
      {
      nspf = sprintf(CODE.CODE+myoff,"%6.6d:\r",jj);
      myoff += nspf;
      }

   CGN_UPCOPY(savdef,TOKEN[8].STR,6);		/* test for THEN */
   savdef[6] = '\0';
   if ( strcmp(savdef,"THEN") == 0 ) 
      {
      *offset = myoff;
      return (0);
      }
   kk = 8;


else_check:
   if (TOKEN[0].STR[0] == 'E') 
      {					/* for ELSEIF we need THEN ... */
      ERRORS.SYS = 74;
      goto error_ret;
      }


   /*  check, if we have to preprocess the command  */

   n = CGN_INDEXC("BGRP",savdef[0]);
   if (n >= 0)
      {
      if ( (strcmp(savdef,"GOTO") == 0) ||
           (strcmp(savdef,"PAUSE") == 0) ||
           (strcmp(savdef,"BRANCH") == 0) )
         ;						/* NOOP */
      else if (strncmp(savdef,"RETURN",6) == 0)
         {
         if ( (TOKEN[kk].STR[6] == '/') && 
              ((TOKEN[kk].STR[7] == 'E') || (TOKEN[kk].STR[7] == 'e')) )
              savdef[1] = 'X';
         }
      else
         goto sect_5900;

      CODE.CODE[myoff++] = '*';
      CODE.CODE[myoff++] = savdef[0];
      CODE.CODE[myoff++] = savdef[1];
      CODE.CODE[myoff++] = ' ';
      kk ++;
      }


sect_5900:
   for (nr=kk; nr<MONIT.COUNT; nr++)	 /* put "true action" into next line */
      {
      (void) memcpy(CODE.CODE+myoff,TOKEN[nr].STR,(size_t)TOKEN[nr].LEN);
      myoff += TOKEN[nr].LEN;
      CODE.CODE[myoff++] = ' ';
      }

   CODE.CODE[myoff-1] = '\r';
   goto sect_7100;			/* now continue like  ENDIF ...  */



   case 1:				/*  expand ELSE command  
   ---------------------------------------------------- */

   if (ifdx < 0) 
      {
      ERRORS.SYS = 75;
      goto error_ret;
      }

   if (MONIT.COUNT > 1)		/* look for ELSE IF */
      {
      CGN_UPSTR(TOKEN[1].STR);
      if ((TOKEN[1].STR[0] == 'I') && (TOKEN[1].STR[1] == 'F'))
         {
         if (MONIT.COUNT > 9)
            {
            MONIT.COUNT --;
            for (nr=1; nr<MONIT.COUNT; nr++)
               TOKEN[nr].LEN = CGN_COPY(TOKEN[nr].STR,TOKEN[nr+1].STR);
            TOKEN[9].STR[0] = '?';
            TOKEN[9].STR[1] = '\0';
            TOKEN[9].LEN = 1;
            }
         else
            {
            for (nr=1; nr<MONIT.COUNT; nr++)
               TOKEN[nr].LEN = CGN_COPY(TOKEN[nr].STR,TOKEN[nr+1].STR);
            MONIT.COUNT --;
            }
         goto sect_5040;		/* goto ELSEIF section */
         }
          
      ERRORS.SYS = 5;			/* no, so it's a syntax error */
      goto error_ret;
      }


  /* update label no. for next ELSE and ENDIF  */
 
   if (if_first[ifdx] == 0)		/* but only if it's first time */
      {
      if_end[ifdx] = labl_count++;
      if_first[ifdx] = 1;
      }
   nspf = sprintf(CODE.CODE+(*offset),"*GO %6.6d\r%6.6d:\r",
           if_end[ifdx],if_else[ifdx]);
   if_else[ifdx] = if_end[ifdx];	/* after this there must be ENDIF!  */

   *offset += nspf;
   return (0);


	
   case 3:				/*  expand ENDIF command  
   ---------------------------------------------------- */

   if (ifdx < 0) 
      {
      ERRORS.SYS = 76;
      goto error_ret;
      }

   myoff = *offset;
   if (if_end[ifdx] != if_else[ifdx])
      {
      nspf = sprintf(CODE.CODE+myoff,"%6.6d:\r",if_else[ifdx]);
      myoff += nspf;
      }
   (void) sprintf(save,"%6.6d",if_end[ifdx]);	/* get saved label no.  */

sect_7100:
   (void) memcpy(CODE.CODE+myoff,save,(size_t)6);
   myoff += 6;
   CODE.CODE[myoff++] = ':';
   CODE.CODE[myoff++] = '\r';
   CODE.CODE[myoff] = '\r';
   *offset = myoff;			/* don't pass over second '\r'...  */
   ifdx -- ;				/* decrement IF nesting level  */
   return (0);



   case 8:				/*  INIT  
   ---------------------------------------------------- */

   dodx = -1;		/*  initialize pointers + variables  */
   ifdx = -1;
   labl_count = 0;
   return (0);



   case 9:				/*  FINISH  
   ---------------------------------------------------- */

   myoff = (*offset) + 1;               /* ensure NULL terminated CODE */
   CODE.CODE[myoff] = '\0';

   if (dodx >= 0) 
      ERRORS.SYS = 77;
   else if (ifdx >= 0) 
      ERRORS.SYS = 78;
   else
      return (0);

   }


/* here we handle the errors */

error_ret:
errpntr = blank;
error_ret1:
PREPERR("MIDAS",LINE.STR,errpntr);
return (ERRORS.SYS);
}

/*

*/

#ifdef __STDC__
int PARDEFS(char action,char *comqual)
#else
int PARDEFS(action,comqual)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  define, find, display + delete default values of MIDAS commands
.ALGORITHM
  no. of commands/qualifs + the defaults info are held in structure DEFAULTS
.RETURN
 return value:		= 0, o.k.
			= 1, problems in memory allocation
			= 2, command/qualifier not found here ...
			= 3, default string too long ( > 100)
			= 4, invalid action flag
			= -1/-2, could not set `defaults' flag of comnd/qualif
			         (= return code from SETDFF)
------------------------------------------------------------------------*/
	
char   action;	   /* IN: action flag           \
                      I(nit), F(ind), A(dd), D(elete) or S(how)  */
char   *comqual;   /* IN: commandqualif string */
#endif

{
int   n, next, size, mm;
register int  nr;

char   *cpntr, *limpntr, *tmpntr;

struct DEF_STRUCT  *ndefpntr;

	
if (action == 'I') 			/* initialize the DEFAULTS structure */
   {
   DEFAULTS.MAX = DEF_LIM;
   size = (sizeof(struct DEF_STRUCT)) * (DEFAULTS.MAX+1); /* +1 for security */
   tmpntr = malloc((size_t)size);
   if (tmpntr == (char *) 0) 
      {
      (void) printf(
             "could not allocate %d bytes for DEFAULTS structure\n",size);
      return (1);
      }

   DEFAULTS.BYTES = tmpntr;		/* save original char. pointer */
   DEFAULTS.PNTR = (struct DEF_STRUCT *) tmpntr;
   DEFAULTS.LAST = 0;			/* no entry there yet  */
   }

else

   {
   defpntr = DEFAULTS.PNTR;


   if (action == 'F') 	/*  find command/qualif + fill with defaults  */
      {
      for (nr=0; nr<DEFAULTS.LAST; nr++)
         {
         if ( strncmp(comqual,defpntr->COMQUAL,10) == 0 )
            goto find_1;
         defpntr ++;
         }
      return (2);		/*  no defaults defined  for this command  */


      /* modify total par. count as well  */

find_1:
      mm = defpntr->COUNT + 1;               /* parameters + command */
      if (mm > MONIT.COUNT) MONIT.COUNT = mm;
      mm --;						/* set `mm' back */
      cpntr = defpntr->STR;			/* defaults start here...  */

      for (n=1; n<MONIT.COUNT; n++)
         {
         if (n > mm) break;                /* no more defaults there ... */
         size = (int) strlen(cpntr);
         if ( (TOKEN[n].STR[0] == '?') && (TOKEN[n].LEN == 1) )
            {
            TOKEN[n].LEN = size;
            (void) memcpy(TOKEN[n].STR,cpntr,(size_t)(size+1));
            }
         cpntr += (size+1);                          /* follow with pointer  */
         }
      }


   else if (action == 'D') 		/*  delete command/qualifier  */
      {	

      for (nr=0; nr<DEFAULTS.LAST; nr++)
         {
         if (defpntr->COMQUAL[0] != '/')
            {
            if (*comqual == '?')
               {
               defpntr->COMQUAL[0] = '/';       /* that's the `delete' char. */
               mm = SETDFF(comqual,comqual+6,0);    /* clear `defaults' flag */
               }
            else
               {
               if ( strncmp(comqual,defpntr->COMQUAL,10) == 0 )
                  {
                  defpntr->COMQUAL[0] = '/';
                  mm = SETDFF(comqual,comqual+6,0);
                  return (0);
                  }
               }
            }

         defpntr ++;
         }

      if (*comqual != '?') 
         return (2);
      else
         DEFAULTS.LAST = 0;
      }


   else if (action == 'A') 		/*  add command/qualif + defaults  */
      {
      
      next = -1;
      for (nr=0; nr<DEFAULTS.LAST; nr++)
         {
         if ( strncmp(comqual,defpntr->COMQUAL,10) == 0 )
            goto add_2;
         if ((next < 0) && (defpntr->COMQUAL[0] == '/')) 
            next = nr;

         defpntr ++;
         }

      if (next >= 0) 
         {
         defpntr = DEFAULTS.PNTR + next;
         goto add_1;
         }
      else if (DEFAULTS.LAST < DEFAULTS.MAX)
         {
         defpntr = DEFAULTS.PNTR + DEFAULTS.LAST;	/* => 1. free entry */
         DEFAULTS.LAST ++;
         goto add_1;
         }


      /* we have to expand the DEFAULTS structure */

      DEFAULTS.MAX *= 2;
      size = (sizeof(struct DEF_STRUCT)) * (DEFAULTS.MAX+1);
      tmpntr = malloc((size_t)size);
      if (tmpntr == NULL)
         {
         (void) printf(
                "could not allocate %d bytes for DEFAULTS structure\n",size);
         return (1);
         }

      defpntr = DEFAULTS.PNTR;		/* point to old structure */
      DEFAULTS.PNTR = (struct DEF_STRUCT *) tmpntr;
      ndefpntr = DEFAULTS.PNTR;		/* point to new, larger space */

      for (nr=0; nr<DEFAULTS.LAST; nr++)	/* copy existing defaults */
         {
         (void) memcpy(ndefpntr->COMQUAL,defpntr->COMQUAL,(size_t)10);
         (void) memcpy(ndefpntr->STR,defpntr->STR,(size_t)82);
         ndefpntr->COUNT = defpntr->COUNT;
         ndefpntr ++; defpntr ++;
         }


      /*  release old DEFAULTS structure */

      free(DEFAULTS.BYTES);
      DEFAULTS.BYTES = tmpntr;             /* save new char. pointer */
      defpntr = DEFAULTS.PNTR + DEFAULTS.LAST;       /* => 1. free entry */
      DEFAULTS.LAST ++;


      /*  slot found...  */

add_1:
      (void) memcpy(defpntr->COMQUAL,comqual,(size_t)10);

add_2:
      cpntr = defpntr->STR;	      /* points to begin of default string  */
      limpntr = cpntr + MAX_TOKEN;

      for (n=2; n<MONIT.COUNT; n++)	/* MONIT.COUNT > 2 for sure */
         {
         mm = TOKEN[n].LEN;
         if ((cpntr+mm) >= limpntr) 
            return (3);			/* defaults string > MAX_TOKEN + 2 */
   
         mm++;					/* include the '\0' */
         (void) memcpy(cpntr,TOKEN[n].STR,(size_t)mm);
         cpntr += mm;			/* follow with pointer  */
         }
   
      defpntr->COUNT = MONIT.COUNT - 2;
      mm = SETDFF(comqual,comqual+6,1);
      if (mm != 0) return (mm);
      }


   else if (action == 'S')		/*  show command/qualif + defaults */
      {
      char  outbuf[104];
      int  kk, k;

      if (DEFAULTS.LAST < 1)
         {
         (void)printf("no defaults defined ...\n");
         return (0);
         }

      next = 0;				/* counter of entries */
      for (nr=0; nr<DEFAULTS.LAST; nr++)
         {
         cpntr = defpntr->COMQUAL;
         if (*cpntr != '/')		/* valid entry found */
            {
            memset((void *)outbuf,32,(size_t)100);
            limpntr = outbuf;

            k = FINDCOM(cpntr,cpntr+6,outbuf,&mm,&kk,&tmpntr,&kk);
            if ((k == 0) && (mm == 1))		/* only if command is o.k. */
               {				/* are we using the defaults */
               (void) memcpy(limpntr,cpntr,(size_t)6);
               limpntr += 6;
               *limpntr++ = '/';
               cpntr += 6;
               (void) memcpy(limpntr,cpntr,(size_t)4);
               limpntr += 5;
   
               cpntr = defpntr->STR;
               for (mm=0; mm<defpntr->COUNT; mm++)
                  {
                  size = CGN_COPY(limpntr,cpntr);
                  limpntr += size;
                  *limpntr++ = ' ';
                  cpntr += (size+1);
                  }

               *limpntr = '\0';
               (void)printf("%s\n",outbuf);
               next ++;
               }
            else
               *cpntr = '/';		/* remove outdated entry */
            }

         defpntr ++;
         }

      if (next > 0)
         (void) printf("%d entries in default table",next);
      }


   else 			/*  wrong action flag */
      return (4);
   }

return (0);
}

/*

*/

int SETMID(info)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  handle the command SET/MIDAS_SYSTEM
.ALGORITHM
  just bounce ahead
.RETURN
 return value:                  = 0, o.k.
                                = ERRORS.SYS code
------------------------------------------------------------------------*/

int  *info;		/* OUT: (1) = option used  
				(2) = value to be used in `prepx.c'  */

{
int  kk, n, nb, ncou, ksta, m, tlen;
int  unit, iwa, iwb[2];
register int  nr;


char  *cpntr, *cxpntr, csave[MAX_TOKEN], savy[12];
register char cc;

extern char  DATA_PATH[328];

#define MIDSYSNO   27
static char     *midsys[MIDSYSNO] = {"USER","ENVI","PROM","DPAT","PATH",
				     "DQ","KEYW","COMM","EDIT","OUTP",
				     "DSCC","CLOV","DEBU","EPAT","MAXT",
				     "DUMM","F_HEA","INSE","NEWF","F_UP",
				     "WORK","DSCA","SELI","ESO-","SQUO",
				     "WCS-","LONG"};
float rwa;

double dwa;



parse_options:
*info = 0;
for (ncou=1; ncou<MONIT.COUNT; ncou++)
   {
   ERRORS.INDEX = ncou;
   n = CGN_INDEXC(TOKEN[ncou].STR,'=');
   if (n < 1) return(5);
   if (n > 3)
      m = 4;
   else
      m = n;

   CGN_UPCOPY(csave,TOKEN[ncou].STR,m);
   csave[m] = '\0';

   for (nr=0; nr<MIDSYSNO; nr++)
      {
      if (CGN_INDEXS(midsys[nr],csave) >= 0)
         {						/* copy after = */
         CGN_strcpy(TOKEN[ncou].STR,&TOKEN[ncou].STR[++n]);
         tlen = TOKEN[ncou].LEN - n;
         if (tlen > 0)
            CGN_UPCOPY(KAUX.OUT,TOKEN[ncou].STR,tlen+1);  /*  -> upper case */
         else
            (void) strcpy(KAUX.OUT,"  ");
         nb = nr;
         goto next_tri;
         }
      }

   ERRORS.INDEX = ncou;
   return (30);                   /* no valid key_par found */


next_tri:
   switch(nb)
      {


     case 0:                        /* USER_MODE=string
     -------------------------------------------------- */

      m = OFF_ERROR + 1;
  
      if (KAUX.OUT[0] == '?')
         disp_midvals(m,"USER_MODE");
      else
         {
         kk = OFF_ERROR + 4;
         ksta = 0;
         KAUX.OUT[tlen] = '\0';
         n = CGN_EXTRSS(KAUX.OUT,tlen,',',&ksta,csave,10);

         while (n > 0)
            {                              /* set keyword ERROR(2)/ERROR(5) */
            if ( strncmp(csave,"US",2) == 0)
               KIWORDS[m] = 0;
            else if ( strncmp(csave,"EX",2) == 0)
               KIWORDS[m] = 2;
            else if ( strncmp(csave,"SU",2) == 0)
               KIWORDS[m] = 3;
            else if ( strncmp(csave,"PR",2) == 0)
               KIWORDS[kk] = 1;
            else if ( strncmp(csave,"NOP",3) == 0)
               KIWORDS[kk] = 0;
            else
               KIWORDS[m] = 1;

            n = CGN_EXTRSS(KAUX.OUT,tlen,',',&ksta,csave,10);
            }
         }
      break;

 
     case 1:               /*  ENVIRONMENT=HOST or =MIDAS or =MIDHOST
     --------------------------------------------------  */

      if (KAUX.OUT[0] == 'H')
         FRONT.ENV = '$';
      else if (strncmp(KAUX.OUT,"MIDHO",5) == 0)
         FRONT.ENV = ':';                   /* 1. MIDAS - 2. Host  */
      else
         FRONT.ENV = '>';                   /* default to MIDAS environment  */
      break;


     case 2:               /*  PROMPT=prompt_string  
     --------------------------------------------------   */

      if (KAUX.OUT[0] == '?')
         {
         (void) strncpy(KAUX.OUT,FRONT.PROMPT,(size_t)FRONT.PEND);
         KAUX.OUT[FRONT.PEND] = ' ';
         m = FRONT.PEND + 1;			/* we also write the blank */
         (void) SCKWRC("OUTPUTC",1,KAUX.OUT,1,m,&unit);
         KAUX.OUT[FRONT.PEND] = '\0';
         (void) sprintf(csave,"current prompt = %s",KAUX.OUT);
         SCTPUT(csave);
         }
      else
         {
         if (TOKEN[ncou].STR[0] == '\\')
            {			      /* \? puts '?' into the prompt string */
            CGN_strcpy(TOKEN[ncou].STR,&TOKEN[ncou].STR[1]);
            tlen --;
            }
         if (tlen > 16)
            {
            TOKEN[ncou].STR[16] = '\0'; m = 16;
            }
         else
            m = tlen;

         (void) strcpy(FRONT.PROMPT,TOKEN[ncou].STR);
         FRONT.PROMPT[m] = ' ';
         FRONT.PEND = m + 1;
         }
      break;


     case 3:               /* DPATH=dirspec1|dirspec2|...|dirspecn
     --------------------------------------------------  */

      cxpntr = (char *) malloc((size_t) 328);
      if (cxpntr == (char *) 0)
         {
         (void) sprintf(KAUX.OUT,
               "Problems with DPATH=%s command...", TOKEN[ncou].STR);
         SCTPUT(KAUX.OUT);
         return (80);
         }
 
      (void) strncpy(cxpntr,&KCWORDS[OFF_DPATH],(size_t)320);
      *(cxpntr+320) = '\0';
      cpntr = cxpntr;

      if (KAUX.OUT[0] == '?')
         {
         if (KAUX.OUT[1] != '?')        /* DPATH=?? only sends to server */
            {
            for (n=0; n<4; n++)
               {
               if (*cpntr != '^')
                  {
                  (void) strncpy(KAUX.OUT,cpntr,(size_t)80);	/* dir_path max. 80 */
                  KAUX.OUT[80] = '\0';
                  SCTPUT(KAUX.OUT);
                  }
               else
                  break;
  
               cpntr += 80;
               }
            }
         }

      else
         {
         int  poff, loff;

         if ((tlen <= 0) || (TOKEN[ncou].STR[0] == ' '))
            {                                   /* DPATH=   is a reset */
            for (n=0; n<4; n++)
               {
               *cpntr = '^'; cpntr += 80;
               }
            }

         else
            {
            (void) strcpy(KAUX.OUT,TOKEN[ncou].STR);	/* undo the UPCOPY */
            if (KAUX.OUT[0] == '+')     /* add to current DPATH */
               {
               for (n=0; n<4; n++)
                  {
                  if (*cpntr == '^')
                     {
                     poff = n; loff = 1;
                     goto dpath_loop;
                     }
                  cpntr += 80;
                  }
               free(cxpntr);
               return (102);
               }
            else
               {
               poff = 0; loff = 0;
               }

            dpath_loop:
            memset((void *)cpntr,32,(size_t)80);
            kk = CGN_INDEXC(&KAUX.OUT[loff],'|');
            if (kk > 0) KAUX.OUT[loff+kk] = '\0';
            DIR_Expand(&KAUX.OUT[loff],cpntr);
            m = (int) strlen(cpntr);
            *(cpntr+m) = ' ';                   /* replace by a ' ' */
            if ((kk > 0) && (poff < 3))
               {
               loff += (kk+1); poff ++; cpntr += 80;
               goto dpath_loop;
               }
            }
         (void) strncpy(&KCWORDS[OFF_DPATH],cxpntr,(size_t)320);    /* write back */
         (void) strncpy(DATA_PATH,cxpntr,(size_t)320);    /* also into DATA_PATH */
         }

      (void) SCKRDI("IDIDEV",1,1,&m,&iwa,&unit,&n);
      if (iwa >= 0)                      /* test IDIDEV(1) */
         {
         n = IDI_SINI();
         if (n == 0)
            {
            IISSIN_C(iwa,2,cxpntr);     /* send also to IDI-server */
            IDI_SCLS();
            }
         }

      free(cxpntr);
      break;


     case 4:               /*  PATH=dirspec1|dirspec2|...|dirspecn
     --------------------------------------------------  */

      if (KAUX.OUT[0] == '?')
         {
         for (n=0; n<4; n++)
            {
            if (CPATH[n].STR[0] != '\0')
               SCTPUT(CPATH[n].STR);
            else
               break;
            }
         }
 
      else
         {
         int  poff, loff;

         if ((tlen <= 0) || (TOKEN[ncou].STR[0] == ' '))
            {					/* PATH=  is default */
            OSY_GETSYMB("MID_WORK",CPATH[0].STR,80);
            CPATH[1].STR[0] = '\0';		/* mark the end */
            }

         else
            {
            (void) strcpy(KAUX.OUT,TOKEN[ncou].STR);	/* undo the UPCOPY */
            if (KAUX.OUT[0] == '+')	/* add to current PATH */
               {
               for (n=0; n<4; n++)
                  {
                  if (CPATH[n].STR[0] == '\0')
                     {
                     poff = n; loff = 1;
                     goto path_loop;
                     }
                  }
               return (102);
               }
            else
               {
               poff = 0; loff = 0;
               }

            path_loop:
            kk = CGN_INDEXC(&KAUX.OUT[loff],'|');
            if (kk > 0) KAUX.OUT[loff+kk] = '\0';
            DIR_Expand(&KAUX.OUT[loff],CPATH[poff].STR);
            if ((kk > 0) && (poff < 3))
               {
               loff += (kk+1); poff ++;
               goto path_loop;
               }
            }
         }
      break;


     case 13:               /* EPATH=dirspec1|dirspec2|...|dirspec4
     --------------------------------------------------  */

      if (KAUX.OUT[0] == '?')
         {
         for (n=0; n<4; n++)
            {
            if (EPATH[n].STR[0] != '\0')
               SCTPUT(EPATH[n].STR);
            else
               break;
            }
         }

      else
         {
         int  poff, loff;

         if ((tlen <= 0) || (TOKEN[ncou].STR[0] == ' '))
            {                                   /* EPATH=  is default */
            OSY_GETSYMB("MID_WORK",EPATH[0].STR,80);
            EPATH[1].STR[0] = '\0';             /* mark the end */
            }

         else
            {
            (void) strcpy(KAUX.OUT,TOKEN[ncou].STR);	/* undo the UPCOPY */
            if (KAUX.OUT[0] == '+')     /* add to current EPATH */
               {
               for (n=0; n<4; n++)
                  {
                  if (EPATH[n].STR[0] == '\0')
                     {
                     poff = n; loff = 1;
                     goto epath_loop;
                     }
                  }
               return (102);
               }
            else
               {
               poff = 0; loff = 0;
               }

            epath_loop:
            kk = CGN_INDEXC(&KAUX.OUT[loff],'|');
            if (kk > 0) KAUX.OUT[loff+kk] = '\0';
            DIR_Expand(&KAUX.OUT[loff],EPATH[poff].STR);
            if ((kk > 0) && (poff < 3))
               {
               loff += (kk+1); poff ++;
               goto epath_loop;
               }
            }
         }
      break;


     case 5:               /*  DQ=YES/NO 
     --------------------------------------------------  */

      m = OFF_AUX + 4;
      (void) strcpy(savy,"DQ");
      goto sect_1100;


     case 6:               /*  KEYWORDS=globno,locno 
     --------------------------------------------------  */

      kk = KEYALL.LOCENT - KEYALL.GLOBENT;

      if (KAUX.OUT[0] == '?')
         {
         iwb[0] = KEYALL.GLOBENT;
         iwb[1] = kk;
         (void) SCKWRI("OUTPUTI",iwb,1,2,&unit);
         (void) sprintf(csave,
                "current no. of global keywords = %d, of local keywords = %d",
                iwb[0],iwb[1]);
         SCTPUT(csave);
         }
      else
         {
         m = CGN_CNVT(TOKEN[ncou].STR,1,2,iwb,&rwa,&dwa);
         if (m < 1) return (5);

         n = 0;
         if (iwb[0] <= KEYALL.GLOBENT)
            {
            n ++; iwb[0] = KEYALL.GLOBENT;
            }
         if ((m < 2) || (iwb[1] <= kk))
            {
            n ++; iwb[1] = kk;
            }
         if (n == 2) break;			/* nothing to do ... */

         KIWORDS[OFF_MONPAR+2] = iwb[0];
         KIWORDS[OFF_MONPAR+3] = iwb[1];
         MID_MOVKEY("O",csave);                  /* move keys out */
         m = MID_MOVKEY("IX"," ");		/* and extend */
         if (m != ERR_NORMAL) return(100);

         (void) sprintf(csave,
                "global, local keywords will be expanded to %d, %d",
                iwb[0],iwb[1]);
         SCTPUT(csave);
         }

      break;


     case 7:               /*  COMMS=commno,qualifno 
     -------------------------------------------------- */

      if (KAUX.OUT[0] == '?')
         {
         iwb[0] = COMN.CMAX;
         iwb[1] = COMN.QMAX;
         (void) SCKWRI("OUTPUTI",iwb,1,2,&unit);
         (void) sprintf(csave,
                "current no. of commands = %d, of qualifiers = %d",
                COMN.CMAX,COMN.QMAX);
         SCTPUT(csave);
         }

      else
         {
         m = CGN_CNVT(TOKEN[ncou].STR,1,2,iwb,&rwa,&dwa);
         if (m < 1) return (5);

         n = 0;
         if (iwb[0] <= COMN.CMAX)
            {
            n ++; iwb[0] = COMN.CMAX;
            }
         if ((m < 2) || (iwb[1] <= COMN.QMAX))
            {
            n ++; iwb[1] = COMN.QMAX;
            }
         if (n == 2) break;                     /* nothing to do ... */

         (void) sprintf(csave,
         "commands, qualifiers will be expanded to %d, %d",iwb[0],iwb[1]);
         SCTPUT(csave);
         KIWORDS[OFF_MONPAR] = iwb[0];
         KIWORDS[OFF_MONPAR+1] = iwb[1];
         INITCOM();
         TOKEN[1].LEN = CGN_COPY(TOKEN[1].STR,"-all");
         (void) Contexter(0);
         SCTPUT("all contexts cleared...");
         SCTPUT("all added commands have to be recreated...");
         }

      break;


     case 8:                    /*  EDIT=editor 
     -------------------------------------------------- */

      m = OFF_SYS + 20;
      (void) strcpy(savy,"editor");
      goto sect_1200;


     case 9:               /*  OUTPUT=YES, =NO or =LOGONLY 
                               =DEFault,=BLA,=RED,=GRE,=BLU,=YEL,
                               =MAG,=CYAN,=WHITE 
     -------------------------------------------------- */

      m = OFF_LOG + 3;		/* mode is stored in LOG(4) */
      cc = KAUX.OUT[0];

      if (cc == '?')
         disp_midvals(m,"OUTPUT");
      else if (cc == 'N')		/* NO */
         KIWORDS[m] = 2;
      else if (cc == 'L')		/* LOGONLY */
         KIWORDS[m] = 1;
      else if (cc == 'Y')		/* YES or YELLOW */
         {
         if (KAUX.OUT[2] == 'L')
            KIWORDS[m-2] = M_YELLOW_COLOR;	/* colors => LOG(2) */
         else
            KIWORDS[m] = 0;
         }

      /* finally, check for colours */
      else	
         {
         m -= 2;			/* colors are stored in LOG(2) */
         KIWORDS[m] = M_DEF_COLOR;
         if (cc == 'B')
            {
            if (KAUX.OUT[2] == 'U') 
               KIWORDS[m] = M_BLUE_COLOR;
            else
               KIWORDS[m] = M_BLACK_COLOR;
            }
         else if (cc == 'R')
            KIWORDS[m] = M_RED_COLOR;
         else if (cc == 'G')
            KIWORDS[m] = M_GREEN_COLOR;
         else if (cc == 'M')
            KIWORDS[m] = M_MAGNT_COLOR;
         else if (cc == 'C')
            KIWORDS[m] = M_CYAN_COLOR;
         else if (cc == 'W')
            KIWORDS[m] = M_WHITE_COLOR;
         }
      break;


     case 10:               /*  DSCCOPY=YES, =NO 
     --------------------------------------------------*/

      m = OFF_AUX + 3;
      (void) strcpy(savy,"DSCCOPY");
      goto sect_1100;


     case 11:               /*  CLOVERLAY=YES, =NO 
     -------------------------------------------------- */

      m = OFF_AUX + 8;
      (void) strcpy(savy,"CLOVERLAY");

sect_1100:
      if (KAUX.OUT[0] == '?')
         disp_midvals(m,savy);
      else if (KAUX.OUT[0] == 'Y')
         KIWORDS[m] = 1;
      else
         KIWORDS[m] = 0;                /* all else is NO  */
      break;


     case 12:                    /* DEBUG=debugger      
     -------------------------------------------------- */

      m = OFF_DEBUG;
      (void) strcpy(savy,"debugger");

sect_1200:
      kk = 40;				/* max. 40 chars. */
      if (KAUX.OUT[0] == '?')
         {
         (void) SCKWRC("OUTPUTC",1,&KCWORDS[m],1,kk,&unit);
         (void) strncpy(KAUX.OUT,&KCWORDS[m],(size_t)kk);
         KAUX.OUT[kk] = '\0';
         (void) sprintf(csave,"current %s = %s",savy,KAUX.OUT);
         SCTPUT(csave);
         }

      else
         {
         KCWORDS[m++] = '$'; 
	 kk --;
         if (tlen > kk) return (100);
         memset((void *)&KCWORDS[m],32,(size_t)kk);
         (void) strncpy(&KCWORDS[m],TOKEN[ncou].STR,tlen);
         }
      break;


     case 14:                    /* MAXTIME = secs 
     -------------------------------------------------- */

      kk = MONIT.LEVEL;
      if (KAUX.OUT[0] == '?')
         {
         (void) sprintf(KAUX.OUT,"maxtime at level %d = %d seconds",
                        kk,MONIT.MXT[kk]);
         SCTPUT(KAUX.OUT);
         iwb[0] = MONIT.MXT[kk];
         (void) SCKWRI("OUTPUTI",iwb,1,1,&unit);
         }

      else
         {
         m = CGN_CNVT(KAUX.OUT,1,2,iwb,&rwa,&dwa);
         if ((m < 1) || (iwb[0] < 0))
            iwb[0] = 0;
         else if (m == 2)                    /* we have MAXTIME,LEVEL */
            {
            if ((-1 < iwb[1]) && (iwb[1] <= MAX_LEVEL)) kk = iwb[1];
            }

         m = iwb[0];
         if ((kk < 1) || (MONIT.MXT[kk-1] == 0))
            {			
            MONIT.MXT[kk] = m;
            MONIT.MAXTIME = m;		/* `original' timeout value */
            if (m > 0)
               MONIT.ENDT[kk] = oshtime() + (long int)m;
            }
         else if (0 < m)		/* if m > previous MXT then */
            {				/* the end_time check fixes it */
            long int new_endt;

            MONIT.MXT[kk] = m;		/* only important, that > 0 */
            new_endt = oshtime() + (long int)m;		/* new end time */

            if (MONIT.ENDT[kk] > new_endt)	/* only update if now less */
               MONIT.ENDT[kk] = new_endt;
            }
         }
      break;


     case 15:                    /* DUMMY=separate (uniform)
     -------------------------------------------------- */

      m = OFF_AUX + 11;			/* AUX_MODE(12) */
      if (KAUX.OUT[0] == 'S')
         KIWORDS[m] = 123;
      else
         KIWORDS[m] = 0;
      break;


     case 16:                    /* F_HEAD=1/2
     -------------------------------------------------- */

      m = OFF_AUX + 9;			/* AUX_MODE(10) */

      if (KAUX.OUT[0] == '?')
         (void) disp_midvals(m,"F_HEAD");
      else
         {
         if (KAUX.OUT[0] == '2')
            {
            KIWORDS[m] = 2;
            }
         else
            {
            KIWORDS[m] = 1;	/* default is orig. mode */
            }
         }
      break;


     case 17:                    /* INSERT_MODE=YES/NO  
     -------------------------------------------------- */

      *info = 77;
      if (KAUX.OUT[0] == 'Y')
         *(info+1) = 1;
      else
         *(info+1) = 0;
      break;



     case 18:			/* NEWFILES=FITS/MIDAS,itype,ttype
     --------------------------------------------------  */

      m = OFF_AUX + 12;			/* AUX_MODE(13) */

      if (KAUX.OUT[0] == '?')
         {
         (void) strcpy(savy,"NEWFILES");
         disp_midvals(m,savy);
         }

      else if (KAUX.OUT[0] == 'F')
         {
         KIWORDS[m] = 1;		/* create FITS files */

         n = CGN_INDEXC(KAUX.OUT,',');
         if (n < 1)
            (void) strcpy(csave,"fits    fits  ");
         else
            {
            if (KAUX.OUT[n+1] == ',')
               {				/* fits,,ttype is bad ...*/
               SCTPUT
               ("set/midas NEWFILE= command: bad syntax, use defaults...");
               (void) strcpy(csave,"fits    fits  ");
               }
            else
               {
               memset((void *)csave,32,(size_t)16);
               cpntr = &TOKEN[ncou].STR[n+1];
               if (*cpntr == '"')		/* "abc..." */
                  {
                  cpntr ++;
                  kk = (int) strlen(cpntr);
                  *(cpntr+kk-1) = '\0';	/* cut off trailing `"' */
                  }
               if (*cpntr == '.') cpntr ++;
               n = CGN_INDEXC(cpntr,',');	/* look for table type */
               if (n < 0)
                  {
                  n = CGN_COPY(csave,cpntr);
                  csave[n] = ' ';
                  csave[8] = 't';
                  (void) strcpy(csave+9,cpntr);
                  }
               else
                  {
                  (void) memcpy(csave,cpntr,n);
                  if (*(cpntr+n+1) == '.') n ++;
                  (void) strcpy(csave+8,cpntr+n+1);
                  }
               }
            }
         (void) SCKWRC("MID$TYPES",1,csave,1,16,&unit);
         }


      else 
         {
         KIWORDS[m] = 0;		/* create Midas files */
         (void) strcpy(csave,"bdf     tbl ");
         (void) SCKWRC("MID$TYPES",1,csave,1,16,&unit);
         }
      break;


     case 19:			/* F_UPDATE=Yes/No 
     -------------------------------------------------- */

      m = OFF_AUX + 13;			/* AUX_MODE(14) */

      if (KAUX.OUT[0] == '?')
         {
         (void) strcpy(savy,"F_UPDATE");
         disp_midvals(m,savy);
         if (KAUX.OUT[1] == '?')
            {
            if (KIWORDS[m] == 1)
               (void) SCKWRC("OUTPUTC",1,"YES  ",1,5,&unit);
            else
               (void) SCKWRC("OUTPUTC",1,"NO   ",1,5,&unit);
            }
         }

      else
         {
         if (KAUX.OUT[0] == 'Y')
            {
            KIWORDS[m] = 1;		/* update FITS files */
            KIWORDS[OFF_AUX+15] = 0; 	/* reset also ESO-DESC_ignore_flag */
            }
         else
            KIWORDS[m] = 0;		/* don't change FITS files */
         }
      break;


     case 20:                   /* WORK=Midas/FITS
     ------------------------------------------------- */

				/* this is a convenience option */
      if (KAUX.OUT[0] == '?')
         {
         TOKEN[1].LEN = CGN_COPY(TOKEN[1].STR,"newfiles=?");
         TOKEN[2].LEN = CGN_COPY(TOKEN[2].STR,"F_UPDATE=?");
         }
      else if (KAUX.OUT[0] == 'F')	/* nothing new  ...             */
         {
         TOKEN[1].LEN = CGN_COPY(TOKEN[1].STR,"newfiles=FITS");
         TOKEN[2].LEN = CGN_COPY(TOKEN[2].STR,"F_UPDATE=Y");
         }
      else
         {
         TOKEN[1].LEN = CGN_COPY(TOKEN[1].STR,"newfiles=Midas");
         TOKEN[2].LEN = CGN_COPY(TOKEN[2].STR,"F_UPDATE=N");
         }			
      MONIT.COUNT = 3;
      goto parse_options;


     case 21:                   /* DSCALL=no,bytes
     ------------------------------------------------- */

      m = OFF_MONPAR + 11;			/* MONITPAR(12,13) */

      n = CGN_CNVT(KAUX.OUT,1,2,iwb,&rwa,&dwa);
      if ((n < 1) || (iwb[0] < 1))
         {
         KIWORDS[m++] = 0; KIWORDS[m] = 0;	/* reset to default */
         }

      else
         {
         if (n < 2)
            {
            KIWORDS[m++] = iwb[0]; 
            KIWORDS[m] = iwb[0] * 8;		/* 8 bytes per descr. */
            }
         else
            {
            KIWORDS[m++] = iwb[0]; 
            KIWORDS[m] = iwb[1];
            }
         }
      break;


     case 22:                    /* SELIDX=YES/NO 
     ------------------------------------------------ */

      m = OFF_MONPAR + 13;			/* MONITPAR(14) */

      if (KAUX.OUT[0] == '?')
         {
         if (KIWORDS[m] == 1)
            (void) printf("SELECT/TABLE creates descr. SELIDX \n");
         else
            (void) printf("SELECT/TABLE does not create descr. SELIDX \n");
         }
      else
         {
         if ((KAUX.OUT[0] == 'N') || (KAUX.OUT[0] == 'n'))
            KIWORDS[m] = 0;
         else
            KIWORDS[m] = 1;
         }
      break;


     case 23:                    /* ESO-DESC=YES/NO 
     ------------------------------------------------ */

      m = OFF_AUX + 15;			/* AUX_MODE(16) */

      if (KAUX.OUT[0] == '?')
         {
         if (KIWORDS[m] == 1)
            (void) printf("ESO.xyz FITS keywords are not read in\n");
         else
            (void) printf("ESO.xyz FITS keywords are read in\n");
         }
      else
         {
         KIWORDS[m] = 0;			/* default = YES */
         if ((KAUX.OUT[0] == 'N') || (KAUX.OUT[0] == 'n'))
            {
            if (KIWORDS[OFF_AUX+13] == 1)
               SCTPUT
               ("FITS Update flag set => SET/MIDAS ESO-DESC=No canceled...");
            else
               KIWORDS[m] = 1;
            }
         }
      break;


     case 24:                    /* SQUOTE=YES/NO 
     ------------------------------------------------ */

      m = OFF_MODE+3;				/* MID$MODE(4) */

      if ((KAUX.OUT[0] == 'N') || (KAUX.OUT[0] == 'n'))
         KIWORDS[m] = 1;
      else
         KIWORDS[m] = 0;

      break;


     case 25:                    /* WCS-FLAG=0/1/2
     ------------------------------------------------ */

      m = OFF_MODE+5;				/* MID$MODE(6) */

      if (KAUX.OUT[0] == '?')
         {
         if (KIWORDS[m] == 2)
            SCTPUT ("WCS-flag = 2 => read and write/update CDi_j");
         else if (KIWORDS[m] == 1)
            SCTPUT ("WCS-flag = 1 => use CDi_j to copmpute the CDELTi");
         else if (KIWORDS[m] == 0)
            SCTPUT 
            ("WCS-flag = 0 => try to use CDELTi, if not there use CDi_j");
         else
            {
            SCTMES(M_RED_COLOR,"invalid value for WCS-flag...");
            SCTMES(M_RED_COLOR,"use read/key mid$mode and help/key mid$mode ");
            }
         }

      else if (KAUX.OUT[0] == '0') 
         KIWORDS[m] = 0;
      else if (KAUX.OUT[0] == '2') 
         KIWORDS[m] = 2;
      else
         KIWORDS[m] = 1;


     case 26:                    /* LONGSTRN=yes/no
     ------------------------------------------------ */

      m = OFF_AUX+10;				/* AUX_MODE(11) */

      if (KAUX.OUT[0] == '?')
         {
         if (KIWORDS[m] == 0)
            SCTPUT ("HISTORY ESO-DESCRIPTORS mechanism is in use");
         else if (KIWORDS[m] == 1)
            SCTPUT ("use the FITS CONTINUE mechanism (LONGSTRN option)");
         }
      else if ((KAUX.OUT[0] == 'Y') || (KAUX.OUT[0] == 'y'))
         KIWORDS[m] = 1;
      else
         KIWORDS[m] = 0;

      }				/* end of switch */

   }                            /* end of loop over all TOKEN */

return (0);
}

/*

*/

void DIR_Expand(instr,outstr)
char  *instr, *outstr;

{
int  n, m;

char buff[120], auxi[80];




/*  ******************* VMS section  *******************  */

/*  the VMS code was kindly provided by Jean-Pierre De Cuyper and
    Henri Van Diest of the Royal Observatory of Belgium in Bruxelles  */


#if vms
if (*instr == '~')
   {
   (void) strcpy(auxi,"SYS$LOGIN");
   (void) OSY_TRNLOG(auxi,outstr,64,&m);
   if (*(instr+1) == '\0')
           goto dir_end;

   (void) strcpy(buff,instr+1);
   goto dir_ecat;
   }

n = CGN_INDEXC(instr,':');              /* translate logical name first */
if (n > 0)
   {
   int k;

   (void) strncpy(auxi,instr,(size_t)n);
   auxi[n] = '\0';
   CGN_UPSTR(auxi);
   (void) OSY_TRNLOG(auxi,outstr,64,&m);   /* jpdc check if length is ok !*/
   k = strcmp(auxi,outstr);
   if (k != 0)
      {
      (void) strcpy(buff,instr+n);
      goto dir_ecat;
      }
   (void) strcpy(outstr,instr);
   CGN_UPSTR(outstr);
   goto dir_end;
   }

(void) OSY_TRNLOG(instr,outstr,64,&m);   /* jpdc check if length is ok !*/
goto dir_end;

dir_ecat:
CGN_UPSTR(buff);
n = 0;
if (buff[n] == ':')  n++;
if (buff[n] == '[')  n++;
if (buff[n] == '.')  n++;

*(outstr+m-1) = '.';
if (*(outstr+m-2) == '.') *(outstr+m-1) = '\0';
(void) strcat(outstr,&buff[n]);
 
dir_end:
m = CGN_INDEXC(outstr,' ');
if (m > 0) *(outstr+m) = '\0';
m = (int) strlen(outstr);
if (*(outstr+m-1) != FSY_DIREND)
   {                                      /* append dir_end */
   ++m;
   *(outstr+m-1) = FSY_DIREND;
   *(outstr+m) = '\0';
   }
if (*(outstr+m-2) == '.')
   {
   --m;
   *(outstr+m-1) = FSY_DIREND;
   *(outstr+m) = '\0';
   }



/*  ******************* Unix section  *******************  */



#else	
if (*instr == '~')
   {
   (void) strcpy(buff,"$HOME/");
   (void) strcat(buff,instr+1);
   }
else
   (void) strcpy(buff,instr);

symb_check:
n = CGN_INDEXC(buff,'$');

if (n > (-1))
   {
   if (n > 0) (void) strncpy(outstr,buff,(size_t)n);

   m = CGN_INDEXC(&buff[n],FSY_DIREND);
   if (m > 0) buff[m+n] = '\0';

   OSY_GETSYMB(&buff[n+1],auxi,80);
   (void) strcpy(outstr+n,auxi);
   if (m > 0)
      {
      buff[m+n] = FSY_DIREND;
      (void) strcat(outstr,&buff[m+n]);
      n = CGN_INDEXC(outstr,'$');
      if (n > 0)
         {
         (void) strcpy(buff,outstr);
         goto symb_check;				/* look for more */
         }
      }
   }
else
   (void) strcpy(outstr,buff);

m = (int) strlen(outstr);
if (*(outstr+m-1) != FSY_DIREND)
   {                                      /* append dir_end */
   *(outstr+m) = FSY_DIREND;
   *(outstr+m+1) = '\0';
   }
#endif

}

/*

*/

void disp_midvals(kidx,optio)
int kidx;
char  *optio;

{
char  cbuff[80], cc;

int  unit, k, m;


k = 0;
if (strncmp(optio,"USE",3) == 0)
   {
   if (KIWORDS[kidx] == 0)
      k = CGN_COPY(KAUX.OUT,"USER,");
   else if (KIWORDS[kidx] == 2)
      k = CGN_COPY(KAUX.OUT,"EXPERT,");
   else if (KIWORDS[kidx] == 3)
      k = CGN_COPY(KAUX.OUT,"SUPER,");
   else 
      k = CGN_COPY(KAUX.OUT,"NOVICE,");
   kidx += 3;				/* point to ERROR(5) */
   if (KIWORDS[kidx] == 0)
      {
      (void) strcpy(&KAUX.OUT[k],"NOPROMPT ");
      k += 9;
      }
   else
      {
      (void) strcpy(&KAUX.OUT[k],"PROMPT ");
      k += 7;
      }
   }

else if (strncmp(optio,"NEWF",4) == 0)
   {
   if (KIWORDS[kidx] == 1)
      {
      k = CGN_COPY(KAUX.OUT,"FITS, default type (image/table): ");
      (void) SCKGETC("MID$TYPES",1,16,&kidx,cbuff);
      cc = cbuff[8];			/* pull out individual types */
      cbuff[8] = ' ';
      m = CGN_INDEXC(cbuff,' ');
      cbuff[m] = '\0';
      cbuff[8] = cc;
      kidx = sprintf(&KAUX.OUT[k],".%s/.%s",cbuff,&cbuff[8]);
      k += kidx;
      }
   else 
      k = CGN_COPY(KAUX.OUT,"Midas");
   }

else if (strncmp(optio,"F_UPD",4) == 0)
   {
   if (KIWORDS[kidx] == 1)
      k = CGN_COPY(KAUX.OUT,"Yes");
   else 
      k = CGN_COPY(KAUX.OUT,"No ");
   }

else if (strncmp(optio,"F_HEA",4) == 0)
   {
   if (KIWORDS[kidx] == 1)
      k = CGN_COPY(KAUX.OUT,"simple mode for single real FITS keywords");
   else if (KIWORDS[kidx] == 2)
      k = CGN_COPY(KAUX.OUT,"single real FITS keyw. -> ESO-DESCRPTORS keyword");
   }

else
   {
   (void) strcpy(KAUX.OUT,"NO  ");

   if (strncmp(optio,"OUT",3) == 0)
      {
      if (KIWORDS[kidx] == 0)
         k = CGN_COPY(KAUX.OUT,"YES ");
      else if (KIWORDS[kidx] == 1)
         k = CGN_COPY(KAUX.OUT,"LOG ");
      }
   else
      {
      if (KIWORDS[kidx] == 1) k = CGN_COPY(KAUX.OUT,"YES ");
      }
   }


(void) SCKWRC("OUTPUTC",1,KAUX.OUT,1,k,&unit);

(void) sprintf(cbuff,"current %s option = %s",optio,KAUX.OUT);
SCTPUT(cbuff);
}
