/* @(#)prepk.c	17.1.1.1 (ESO-DMD) 01/25/02 17:37:41 */
/*===========================================================================
  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 PREPK  +++++++++++++++++++++++++
.LANGUAGE    C
.IDENTIFICATION  Module PREPK
.AUTHOR  K. Banse                  ESO - Garching
.KEYWORDS
MIDAS monitor
.COMMENTS
holds DEFIPAR, TYPE_CHECK, OSYCOMP, DEBUGGY, Contexter

.VERSION  [1.00] 870724: built from FORTRAN version

 020111		last modif
 

.DOC	handling of Pipeline contexts in Midas (Contexter)


Since 000919 the following scheme concerning the instrument pipelines 
is implemented in Midas:

a) the @p command looks for procedures in: $PIPE_HOME/<instrum>/proc

b) Midas> run PIPE_EXE:module
   will look for module.exe in: $PIPE_HOME/<instrum>/exec

c) Midas will (besides MID_CONTEXT, MID_WORK, current direc) also search for
   contexts in: $PIPE_HOME/<instrum>/context

The env. variable PIPE_HOME is set by the user beforehand.
If not set, Midas defaults it to /midas/<version>/pipeline.

a), b), c)  will be updated each time the Midas command

Midas> set/context <instrum>

is executed - that happens when a RB with the line

INSTRUMENT: <instrum> 

is executed.


<instrum> may be one of:  fors1, fors2, uves


Up to version 01FEB there was a problem with PIPE_HOME if given
in the form "abc/.../" (i.e. with closing "/") - it had to be given as
"abc/...", that is fixed since 01SEP.


Internally, in `prepx.c' the contents of the env. var. PIPE_HOME
is saved to PIPE.HOME (always with closing "/").
In Contexter() the following variables are set as:

PIPE.INSTRUM = <instrum>
PIPE.CONT = <instrum>/context/
PIPE.EXE = <instrum>/exec/
PIPE.PROC = <instrum>/proc/

Finally keyword PIPE_PROC is set to PIPE.HOME // PIPE.PROC
for the "@p" command.

-------------------------------------------------------------------------*/
 
#include <fileexts.h>
#include <osyparms.h>
#include <monitdef.h>
#include <midback.h>
#include <osycoms.h>
 
#include <fsydef.h>

#include <stdlib.h>


/*

*/

int DEFIPAR()
 
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
handle all tasks related to DEFINE/PARAMETER ...
.ALGORITHM
use all exisiting facilities
.RETURNS
return status: 0 = o.k.
------------------------------------------------------------------*/
 
{
register int  nr;
int   ikey, inaux;
int    ioff, k, stat, parno;
 
float  fkey;

double	dkey, dval[2];
 
char	save; 
static char   pi[8] = {'1','2','3','4','5','6','7','8'};
static char   shtype[] = {"NITF"};
static char   *oktype[] = {"Number","Image","Table","FitFile"};


 
 
/*  DEFINE/PAR	   Pi default type/option prompt_str limits  */
 
save = TOKEN[1].STR[1];
for (nr=0; nr<8; nr++)
   {
   if (save == pi[nr])
      {
      parno = nr + 1;
      ioff = MONIT.POFF[nr];
      goto go_on;
      }
   }
return (5);				/* invalid Pi given ...  */
 
 

/*  if no parameter passed, we have to do something  */

go_on:
 
   /*  in PROMPT mode, we ask for it and show the current defaults (if any)  */
 
if ( (KCWORDS[ioff] == '?') && (KCWORDS[ioff+1] == ' ') )
   {
   if ( (KIWORDS[OFF_ERROR+4] == 1) && (MONIT.LEVEL == 1) )
      {
      if (TOKEN[4].STR[0] == '"')
         {
         (void) strcpy(TOKEN[4].STR,&TOKEN[4].STR[1]);
         k = TOKEN[4].LEN - 2;
         }
      else
         k = TOKEN[4].LEN;

      (void) memcpy(&TOKEN[4].STR[k]," (default: ",(size_t)11);
      k += 11;
      (void) memcpy(&TOKEN[4].STR[k],TOKEN[2].STR,(size_t)TOKEN[2].LEN);
      k += TOKEN[2].LEN;
      TOKEN[4].STR[k++] = ')';
      TOKEN[4].STR[k++] = ' ';
      TOKEN[4].STR[k] = '\0';
      TOKEN[4].LEN = k;
	
      DO_KEYS('I',TOKEN[4].STR);			/* prompt for input  */
      inaux = KIWORDS[OFF_AUX+6];
      if (inaux < 1)
         {
         if ( (TOKEN[2].STR[0] == '?') && (TOKEN[2].LEN == 1) )
            {
            stat = 31;
            goto badreturn;
            }
         }
      else
         goto sect_29000;			/* continue like the others  */
      }
 
	
   /* if not in PROMPT mode, we only have to ask if no defaults given  */
 
   else if ( (TOKEN[2].STR[0] == '?') && (TOKEN[2].LEN == 1) )
      {
      DO_KEYS('I',TOKEN[4].STR);			/* prompt for input  */
      inaux = KIWORDS[OFF_AUX+6];
      if (inaux < 1)
         {
         stat = 31;
         goto badreturn;			/* nothing entered  */
         }
	
     sect_29000:
      (void) strncpy(TOKEN[2].STR,&KCWORDS[ioff],(size_t)inaux);	
      KCWORDS[ioff] = '?';
      KCWORDS[ioff+1] = ' ';	      /* will be filled via DEFAULTS */
      TOKEN[2].LEN = inaux;
      }
	
   TOKEN[2].STR[TOKEN[2].LEN] = '\0';
   stat = COMPILE(6,&parno);			/* do the default business  */
   if (stat != 0) goto badreturn;
   }
 
	
stat = TYPE_CHECK(parno);			 /* now do the type checking */
if (stat != 0)
   {
   if (stat != 30)  goto badreturn;
   
   save = CGN_UPPER(TOKEN[3].STR[0]);
   for (nr=0; nr<4; nr++)
      {
      if (save == shtype[nr]) break;
      }
   (void) sprintf(KAUX.OUT,"parameter %d has invalid type - should be %s",
                  parno,oktype[nr]);
   SCTPUT(KAUX.OUT);

   DO_KEYS('I',TOKEN[4].STR);		/* prompt for new input  */
   inaux = KIWORDS[OFF_AUX+6];
   if (inaux < 1)
      {
      stat = 31;
      goto badreturn;                       /* nothing entered  */
      }

   (void) strncpy(TOKEN[2].STR,&KCWORDS[ioff],(size_t)inaux);       
   KCWORDS[ioff] = '?';
   KCWORDS[ioff+1] = ' ';          /* will be filled via DEFAULTS */
   TOKEN[2].LEN = inaux;
   TOKEN[2].STR[inaux] = '\0';
   stat = COMPILE(6,&parno);                    /* do the default business  */
   if (stat != 0) goto badreturn;
   stat = TYPE_CHECK(parno);		/* now do the type checking */
   if (stat != 0)  goto badreturn;
   }
 
 
if (TOKEN[4].STR[0] == '"')		/*  check correct prompt string */
   {
   k = TOKEN[4].LEN - 1;
   if ((TOKEN[4].STR[k] != '"') && (MONIT.COUNT > 5))
      {
      stat = 5;
      goto badreturn;
      }
   }
else if (MONIT.COUNT > 6)
   {
   stat = 5;
   goto badreturn;
   }


if (TOKEN[5].STR[0] != '?')		/*  do the limit checks, if required */
   {
   int  jj;

   once_more:
   for (nr=ioff; nr<ioff+MAX_TOKEN; nr++)
      {					/* Param is single number */
      if (KCWORDS[nr] == ' ') 
         {
         KCWORDS[nr] = '\0';
         goto step_k;
         }
      }
   stat = 7;
   goto badreturn;
  
step_k:
   k = CGN_CNVT(&KCWORDS[ioff],4,1,&ikey,&fkey,&dkey);
   KCWORDS[nr] = ' ';		/* reset `\0' to ` '  */

   if (k < 1)			/* for limits, we need a numeric param */
      {
      (void) sprintf(KAUX.OUT,
          "parameter %d should be a number - limits are %s",
           parno,TOKEN[5].STR);
      SCTPUT(KAUX.OUT);
      stat = 30;
      goto badreturn;
      }
   jj = TOKEN[5].LEN - 1;


   /* convert low_lim,hi_lim to double no.s */

   if ( (TOKEN[5].STR[0] == '<') && (TOKEN[5].STR[1] == ',') )
      {
      if (TOKEN[5].STR[2] == '>') 		/* <,> is always o.k. */
         return (0);

      k = CGN_CNVT(&TOKEN[5].STR[2],4,1,&ikey,&fkey,&dval[1]);
      if (k == 1)
         {
         if (dkey <= dval[1])
            return (0);
         else
            goto try_again;
         }
      }

   
   else if ( (TOKEN[5].STR[jj] == '>') && (TOKEN[5].STR[jj-1] == ',') )
      {
      k = CGN_CNVT(TOKEN[5].STR,4,1,&ikey,&fkey,dval);
      if (k == 1) 
         {
         if (dkey >= dval[0]) 
            return (0);
         else
            goto try_again;
         }
      }
   else 
      {
      k = CGN_CNVT(TOKEN[5].STR,4,2,&ikey,&fkey,dval);
      if (k == 2)
         {
         if (dval[0] <= dval[1])
            {
            if ( (dkey >= dval[0])  &&  (dkey <= dval[1]) )
               return (0);
            else
               goto try_again;
            }
         }
      }

   stat = 5;				/* invalid limits */
   ERRORS.INDEX = 5;
   goto badreturn;
 
	
   /* display error message and prompt for input if TOKEN[6].STR = '?'  */

   try_again: 
   (void) sprintf(KAUX.OUT,
          "parameter %d is out of range - legal limits are %s",
             parno,TOKEN[5].STR);
   SCTPUT(KAUX.OUT);
   if (KIWORDS[OFF_MODE+2] != 0) 		/* no retry in batch mode */
      TOKEN[6].STR[0] = 'x';	


   if (TOKEN[6].STR[0] == '?' )
      {
      TOKEN[6].STR[0] = 'x';			/* so we only do it once */

      DO_KEYS('I',TOKEN[4].STR);           /* prompt for new input  */
      inaux = KIWORDS[OFF_AUX+6];
      if (inaux < 1)
         {
         stat = 31;
         goto badreturn;                       /* nothing entered  */
         }

      (void) strncpy(TOKEN[2].STR,&KCWORDS[ioff],(size_t)inaux);
      KCWORDS[ioff] = '?';
      KCWORDS[ioff+1] = ' ';          /* will be filled via DEFAULTS */
      TOKEN[2].LEN = inaux;
      TOKEN[2].STR[inaux] = '\0';
      stat = COMPILE(6,&parno);			/* do the default business  */
      if (stat != 0) goto badreturn;
      stat = TYPE_CHECK(parno);		/* also do type checking again */
      if (stat != 0) goto badreturn;

      goto once_more;			/* try one more time */
      }

   stat = 16;				/* out of bounds...  */
   goto badreturn;
   }
 
 
return (0);					/*  everything o.k.  */

 
badreturn:
(void) sprintf(KAUX.OUT,"In Midas procedure: %s",PROC.FNAME);
SCTPUT(KAUX.OUT);
KIWORDS[OFF_PRSTAT] = parno - 1;
KIWORDS[OFF_PRSTAT+1] = 10;  /* show error from monitor  */
return (stat);
}

/*

*/

int TYPE_CHECK(parno)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  check type of keys P1 or P2,...,P8
  set key PARSTAT(i) to 1 or 0, if match or not
.ALGORITHM
  types to check are: N(umber), I(mage), M(ask) or T(able)
  utilities CGN_NUMBER and CGN_singleframe are used
.RETURN
 status = 0 o.k, else problems...
-------------------------------------------------------------------*/

int   parno  /* IN: parameter no. (1,2,..,8)  */;

{
int   lparm, offset, off2, n, mm, kl, typno;
 
char    savdef[MAX_TOKEN+2], *savpntr, name[MAX_TOKEN+2], tok1;




lparm = KIWORDS[OFF_PCOUNT+parno];              /* parno is in [1,8]  */
n = parno - 1;                          /* this is the parameter no. - 1 */
off2 = OFF_PSTAT + n;                   /* offset of key PARSTAT(n)  */
KIWORDS[off2] = 1;			/* default to correct type  */
tok1 = TOKEN[3].STR[0];                 /* get ?, C, N, I, M or T  */

if ( (tok1 >= 'a') && (tok1 <= 'z') )   /* force to upper case */
   tok1 += ('A' - 'a');
if ((tok1 == '?') || (tok1 == 'C'))     /* default or  */
   return (0);                          /* character strings may be anything */

offset = MONIT.POFF[n];                 /* offset of key Pn  */
(void) strncpy(savdef,&KCWORDS[offset],(size_t)lparm);
savpntr = savdef;			/* default to 1. element  */
n = lparm;				/* avoid updating of lparm */
if ( (*savpntr == '"') &&                   /* take care of " ... "   */
     (tok1 != 'I') && (tok1 != 'T') && (tok1 != 'F') )
   {
   savpntr ++;
   n --;
   }
savdef[n] = '\0';

if ((*savpntr == '+') && (*(savpntr+1) == '\0'))
   return (0);                          /* no checking for "+"  */

if (tok1 == 'N')
   {
   if (CGN_NUMBER(savpntr) == 0)                /* if not a number...  */
      {
      typno = 5;
      KIWORDS[off2] = 0;                        /* turn PARSTAT(n) bad */
      }
   }

else
   {
   if (tok1 == 'I')
      typno = F_IMA_TYPE;
   else if (tok1 == 'T')
      typno = F_TBL_TYPE;
   else if (tok1 == 'F')
      typno = F_FIT_TYPE;
   else
      return (5);                              /* undefined type ... */

   mm = CGN_singleframe(savpntr,typno,name);	/* try to translate name */
   if (mm == 1)
      {
      TOKEN[2].LEN = CGN_COPY(TOKEN[2].STR,name);
      n = COMPILE(6,&parno);			/* update the default */
      if (n != 0) return (n);

      kl = TOKEN[2].LEN;
      if (kl < lparm)				/* do we have to clear? */
         CGN_FILL(KCWORDS+offset,' ',lparm);
      else if (kl > MAX_TOKEN)
         kl = MAX_TOKEN;			/* at most MAX_TOKEN chars. */

      (void) strncpy(&KCWORDS[offset],name,kl);	/* update key Pn  */
      KIWORDS[OFF_PCOUNT+parno] = kl;		/* and PCOUNT */
      }
   }


/* now check via key PARSTAT, if wrong typed parameter entered  */

if ((MONIT.LEVEL > 0) && (KIWORDS[off2] != 1))
   {
   kl = CGN_INDEXC(TOKEN[3].STR,'/');		/* first look for /CONT */
   if (kl > 0)
      {
      tok1 = TOKEN[3].STR[++kl];
      if ((tok1 == 'C') || (tok1 == 'c')) return (0);	/* it's o.k. */
      }
   return (30);					/* type bad */
   }
else
   return (0);

}

/*

*/

int OSYCOMP(comstring)
 
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  translate commands for different host systems
  and translate logical names 
.ALGORITHM
  use translation table in osycoms.h
.RETURNS
  status: 0 = o.k.
        : 1 = o.k., but a noop command
        : else not a recognized host command
----------------------------------------------------------------------*/
 
char *comstring;	/* OUT: cleaned host command line */


{
register int  nr, mr;
int  clen, kk;

char  savbuff[200];




CGN_UPSTR(TOKEN[0].STR);

for (nr=0; nr<OSY_COMCOUNT; nr++)
   {
   if (strcmp(&TOKEN[0].STR[1],OSY_COMS[nr]) == 0)
      {
      if (OSY_DEFS[nr][1] == ' ') return (1);	/* command not relevant 
						   in current host system */
      clen = CGN_COPY(comstring,OSY_DEFS[nr]);
      comstring[clen++] = ' ';
      for (mr=1; mr<MONIT.COUNT; mr++)
         {
         CGN_LOGNAM(TOKEN[mr].STR,savbuff,200);   /* translate logical names */
         kk = CGN_COPY(&comstring[clen],savbuff);
         clen += kk;
         comstring[clen++] = ' ';
         }
      comstring[clen] = '\0';
      return (0);
      }
   }
 
return (5);		/* invalid command */
}

/*

*/

int DEBUGGY(actio,qualif)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  execute the commands DEBUG/MODULE, DEBUG/PROC
                  and  ECHO/ON, OFF, FULL
.ALGORITHM
  straight forward
.RETURNS
  status: 0 = o.k.
        : -1 = wrong command syntax
----------------------------------------------------------------------*/

int actio;
char *qualif;

{
int  nbra, ibuf[2], i, kk, n, iwb[2];

float rwa;

double dwa;



if (actio == 0)		/* debug/module  or  debug/procedure  */
   {
   if ((TOKEN[2].STR[1] == 'F') || (TOKEN[2].STR[1] == 'f'))
      nbra = 0;                 /* indicate that we turn debugging off  */
   else
      nbra = 1;

   if ((TOKEN[1].STR[0] == 'A') || (TOKEN[1].STR[0] == 'a'))
      {
      ibuf[0] = 1;
      ibuf[1] = MAX_LEVEL;              /* do it for all procedure levels */
      }
   else if ((TOKEN[1].STR[1] == 'F') || (TOKEN[1].STR[1] == 'f'))
      {
      nbra = 0;                 /* allow also DEBUG/xxx OFF   */
      ibuf[0] = 1;
      ibuf[1] = MAX_LEVEL;              /* and do it for all procedure levels */
      }
   else if (TOKEN[1].STR[0] == '?')
      {
      if (MONIT.LEVEL == 0)
         ibuf[0] = 1;
      else
         ibuf[0] = MONIT.LEVEL;
      ibuf[1] = ibuf[0];
      }
   else
      {
      kk = CGN_CNVT(TOKEN[1].STR,1,2,iwb,&rwa,&dwa);
      if (kk < 1)
         {
         ERRORS.INDEX = 1;
         ERRORS.SYS = 5;
         return (-1);
         }

      ibuf[0] = iwb[0];
      ibuf[1] = iwb[1];
      if (ibuf[0] < 1) ibuf[0] = 1;
      if (ibuf[0] > MAX_LEVEL) ibuf[0] = MAX_LEVEL;

      if (kk < 2)
         ibuf[1] = ibuf[0];
      else
         {
         if (ibuf[1] < ibuf[0])
            ibuf[1] = ibuf[0];
         else if (ibuf[1] > MAX_LEVEL)
            ibuf[1] = MAX_LEVEL;
         }
      }


   if (qualif[0] == 'M')                /* DEBUG/MODULE  */
      {
      if (nbra == 0)
         kk = 0;
      else
         {
         if ((TOKEN[2].STR[0] == 'N') || (TOKEN[2].STR[0] == 'n'))
            kk = 1;
         else if ((TOKEN[2].STR[0] == 'T') || (TOKEN[2].STR[0] == 't'))
            kk = 3;
         else
            kk = 2;
         }

      for (n=ibuf[0]; n<=ibuf[1]; n++)
         MONIT.MDEBUG[n] = kk;
      for (i=n; i<MAX_LEV1; i++)           /* n = ibuf[1] + 1 now */
         MONIT.MDEBUG[i] = 0;
      }

   else                                 /* DEBUG/PROCEDURE */
      {
      if (nbra == 0)
         kk = 0;
      else
         kk = 1;

      for (n=ibuf[0]; n<=ibuf[1]; n++)
         MONIT.PDEBUG[n] = kk;
      for (i=n; i<MAX_LEV1; i++)           /* n = ibuf[1] + 1 now */
         MONIT.PDEBUG[i] = 0;
      }
   }

else if (actio == 1)
   {
   if ((TOKEN[1].STR[0] == 'A') || (TOKEN[1].STR[0] == 'a'))
      {
      ibuf[0] = 1;
      ibuf[1] = MAX_LEVEL;              /* do it for all procedure levels */
      }
   else if (TOKEN[1].STR[0] == '?')
      {
      if (qualif[1] == 'F')
         {
         ibuf[0] = 1; ibuf[1] = MAX_LEVEL;
         }
      else
         {
         ibuf[0] = MONIT.LEVEL;
         if (ibuf[0] < 1) ibuf[0] = 1;
         ibuf[1] = ibuf[0];
         }
      }
   else
      {
      kk = CGN_CNVT(TOKEN[1].STR,1,2,iwb,&rwa,&dwa);
      if (kk < 1)
         {
         ERRORS.SYS = 5;
         return (-1);
         }
      ibuf[0] = iwb[0];
      ibuf[1] = iwb[1];
      if (ibuf[0] < 1) ibuf[0] = 1;
      if (ibuf[0] > MAX_LEVEL) ibuf[0] = MAX_LEVEL;

      if (kk < 2)
         ibuf[1] = ibuf[0];
      else
         {
         if (ibuf[1] < ibuf[0])
            ibuf[1] = ibuf[0];
         else if (ibuf[1] > MAX_LEVEL)
            ibuf[1] = MAX_LEVEL;
         }
      }

   if (qualif[1] == 'F')
      kk = 0;                           /*   ECHO/OFF   */
   else if (qualif[0] == 'F')
      kk = 2;                           /*   ECHO/FULL  */
   else
      kk = 1;                           /*   ECHO/ON    */

   for (n=ibuf[0]; n<=ibuf[1]; n++)
      MONIT.ECHO[n] = kk;
   for (i=n; i<MAX_LEV1; i++)		/* n = ibuf[1] + 1 now */
      MONIT.ECHO[i] = 0;

   }

return (0);
}

/*

*/

int Contexter(actio)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  execute all Context related commands
.ALGORITHM
  straight forward
.RETURNS
  status:  0 = o.k.
        : -1 = wrong command syntax or bad parameter
        :  9 = we just set a pipeline context ...
----------------------------------------------------------------------*/

int actio;			/* IN: 0 - clear/context
				       1 - set/context  */

{
int  cntno, jj, m, mm, n;
register int nr;

char  *cptr, *cpntr, *cpntra, *cpntrb;
char  save[184], cbuf[20], ctxfile[16];




if (actio == 1)
   {
   if (MONIT.COUNT < 2)
      {
      ERRORS.SYS = 1;
      return (-1);
      }


   /* test for SET/CONTEXT -1 */

   if (strcmp(TOKEN[1].STR,"-1") == 0)
      {
      CONTXT.STACK --;                         /* just decrement counter */
      if (CONTXT.STACK < 0) CONTXT.STACK = 0;
      return (1);
      }


   if (TOKEN[1].LEN > 8)			/* context name length */
      {
      ERRORS.SYS = 5;
      return (-1);
      }

   for (nr=TOKEN[1].LEN; nr<8; nr++)	/* pad with blanks till length 8 */
      TOKEN[1].STR[nr] = ' ';

   TOKEN[1].STR[8] = '\0';
   cpntrb = TOKEN[1].STR;
   CGN_LOWSTR(cpntrb);				/* we need it in lower case */

   jj = 0;
   if (strcmp(cpntrb,"fors1   ") == 0)		/* check, if we execute */
      {						/* a VLT pipeline context */
      (void) strcpy(PIPE.INSTRUM,"fors1");
      jj = 9;
      }
   else if (strcmp(cpntrb,"fors2   ") == 0)
      {
      (void) strcpy(PIPE.INSTRUM,"fors2");
      jj = 9;
      }
   else if (strcmp(cpntrb,"uves    ") == 0) 
      {
      (void) strcpy(PIPE.INSTRUM,"uves");
      jj = 9;
      }
   if (jj == 9)			/* Yes, so update the PIPE structure */
      {
      (void) strcpy(PIPE.CONT,PIPE.INSTRUM);
      (void) strcpy(PIPE.EXE,PIPE.INSTRUM);
      (void) strcpy(PIPE.PROC,PIPE.INSTRUM);
      (void) strcat(PIPE.CONT,"/context/");	/* e.g. "uves/context/" */
      (void) strcat(PIPE.EXE,"/exec/");
      (void) strcat(PIPE.PROC,"/proc/");
      (void) strcpy(save,PIPE.HOME);            /* change key PIPE_HOME */
      (void) strcpy(&save[PIPE.HOME_LEN],PIPE.PROC);
      (void) SCKWRC("PIPE_PROC",1,save,1,150,&n);
      }

   (void) strcpy(ctxfile,cpntrb);
   (void) strcpy(&ctxfile[TOKEN[1].LEN],".ctx");	/* context file */

   cpntra = CONTXT.NAME;			/* point to CONTEXT names */
   cpntr = cpntra;
   jj = -1;
   for (nr=0; nr<MAX_CONTXT; nr++)
      {                                 /* check, if context already enabled */
      if (strncmp(cpntr,cpntrb,8) == 0)
         {
         (void) sprintf(save,"context: %s  already enabled ",cpntrb);
         SCTPUT(save);
         return (1);
         }
      else if (*cpntr == ' ')                   /* look for space */
         {
         if (jj < 0) jj = nr;
         }

      cpntr += 8;
      }


   /*  it's really a new context   */

   if (jj < 0)
      {
      ERRORS.SYS = 41;
      return (-1);
      }

   cpntra += (jj*8);                    /* point to free space */
   (void) strncpy(cpntra,cpntrb,8);

   cntno = jj + 1;			/* context level in [1,MAX_CONTXT] */
   for (nr=0; nr<MAX_CONTXT; nr++)
      {                                   /* add context no. to end of queue */
      if (CONTXT.QUEUE[nr] == 0)
         {
         CONTXT.QUEUE[nr] = cntno;
         break;
         }
      }

   if (CONTXT.STACK == 0) CONTXT.BASE = cntno;		/* set base context */
   CONTXT.STACK ++ ;

   (void) strcpy(LINE.STR,"@ context add ");
   (void) strcpy(&LINE.STR[14],ctxfile);

   if (CONTXT.pdirec[jj] != (char *) 0) 
      {
      (void) free(CONTXT.pdirec[jj]);
      CONTXT.pdirec[jj] = (char *) 0;
      }
   
   if (MONIT.COUNT == 3)			/* add directory to com_line */
      {
      mm = 2;
#if vms
#else
      if (TOKEN[2].STR[0] == '$')		/* translate */
         {
         int  kk;

         kk = MAX_TOKEN - 4;
         (void) OSY_TRNLOG(&TOKEN[2].STR[1],TOKEN[3].STR,kk,&m);  
         if (m < (kk+1)) 
            {
            mm = 3;;
            TOKEN[3].LEN = m;
            }
         }
#endif
      m = TOKEN[mm].LEN;
      if (TOKEN[mm].STR[m-1] != FSY_DIREND)
         {
         TOKEN[mm].STR[m++] = FSY_DIREND;
         TOKEN[mm].STR[m] = '\0';
         }
      cptr = malloc((unsigned int) ++m);	/* actual length + 1 */
      if (cptr == (char *) 0)
         {
         ERRORS.SYS = 80;
         return (-1);
         }
      (void) strcpy(cptr,TOKEN[mm].STR);
      CONTXT.pdirec[jj] = cptr;
      }
   else 
      {
      int iswi;

      iswi = 0;
      (void) strcpy(save,"MID_CONTEXT:");
      (void) strcpy(&save[12],ctxfile);
      n = CGN_OPEN(save,0);		/* try to open in MID_CONTEXT: */
      if (n > -1)
         {
         (void) osaclose(n);
         iswi = 1;
         }
      else
         {
         n = CGN_OPEN(ctxfile,0);	/* try to open in current dir. */
         if (n > -1)
            {
            (void) osaclose(n);
            iswi = 2;
            }
         else				/* try to open in:             */
            {				/* $PIPE_HOME/instrum/context/ */
            (void) strcpy(save,PIPE.HOME);
            (void) strcpy(&save[PIPE.HOME_LEN],PIPE.CONT);
            (void) strcat(save,ctxfile);
            n = CGN_OPEN(save,0);	/* try in pipeline-context dir */
            if (n > -1)
               {
               (void) osaclose(n);
               iswi = 3;
               }
            }
         }

      if (iswi == 2)			/* get current directory */
         {
#if vms
         DIR_Expand("[.]",TOKEN[2].STR);		/* is that correct? */
#else
         (void) osfdelete("Mid_Pipe");
         (void) 
         oshcmd("echo `pwd` > Mid_Pipe",(char *) 0,(char *) 0,(char *) 0);
         m = osaopen("Mid_Pipe",0);
         if (m > -1)
            {
            (void) osaread(m,TOKEN[2].STR,80);
            (void) osaclose(m);
            }
         else
            (void) strcpy(TOKEN[2].STR,"./");
#endif
         m = (int) strlen(TOKEN[2].STR);
         if (TOKEN[2].STR[m-1] != FSY_DIREND)
            {
            TOKEN[2].STR[m++] = FSY_DIREND;
            TOKEN[2].STR[m] = '\0';
            }
         }
      else if (iswi == 3)
         {
         (void) strcpy(save,PIPE.HOME);
         (void) strcpy(&save[PIPE.HOME_LEN],PIPE.CONT);
         m = (int) strlen(save);
         }
      else 
         m = 15;

      cptr = malloc((unsigned int) ++m);
      if (cptr == (char *) 0)
         {
         ERRORS.SYS = 80;
         return (-1);
         }

      if (iswi == 0)
         (void) strcpy(cptr,"MID_WORK:");
      else if (iswi == 1)
         (void) strcpy(cptr,"MID_CONTEXT:");
      else if (iswi == 3)
         (void) strcpy(cptr,save);
      else
         (void) strcpy(cptr,TOKEN[2].STR);
      CONTXT.pdirec[jj] = cptr;
      }

   mm = (int) strlen(LINE.STR);
   LINE.STR[mm++] = ' ';
   (void) strcpy(&LINE.STR[mm],cptr);
   }

else if (actio == 0)
   {
   cpntra = CONTXT.NAME;                        /* point to CONTEXT names */
   (void) strcpy(LINE.STR,"@ context dele ");

   if (MONIT.COUNT > 1)
      {
      CGN_LOWCOPY(cbuf,TOKEN[1].STR,8); /* get context name or flag */
      if (cbuf[0] == '-')                       /* it's a flag */
         {                                      /* `-all' or `-total' */
         int  fid;

         fid = osaopen("middummclear.prg",1);	/* open for writing */
         if (fid < 0) 
            {
            fid = CGN_OPEN("MID_WORK:middummclear.prg",1);
            if (fid < 0) goto bad_a;		/* here it should have worked */
            }

         if (cbuf[1] == 't')                    /* -total */
            {
            INITCOM();
            goto clear_a;
            }
         else if (cbuf[1] == 'a')               /* -all */
            {
            CLEANCOM(0);                        /* clear all context comnds */
            goto clear_a;
            }
             
        bad_a:
         ERRORS.INDEX = 1;
         ERRORS.SYS = 100;
         return (-1);
             
        clear_a:
         jj = 0;
         cpntr = cpntra;
         for (nr=0; nr<MAX_CONTXT; nr++)
            {
            CONTXT.QUEUE[nr] = 0;               /* clear context queue */

            if (*cpntr != ' ')
               {
               jj = 1;
               for (m=7; m>0; m--)
                  {
                  if (*(cpntr+m) != ' ')
                     {
                     jj = m + 1;
                     break;
                     }
                  }

               (void) strncpy(TOKEN[1].STR,cpntr,8);
               TOKEN[1].STR[8] = ' '; 
               m = CGN_INDEXC(TOKEN[1].STR,' ');
               (void) strcpy(&TOKEN[1].STR[m],".ctx");
               m = CGN_COPY(&LINE.STR[15],TOKEN[1].STR) + 15;
               LINE.STR[m++] = ' ';
               (void) strcpy(&LINE.STR[m],CONTXT.pdirec[nr]);
               (void) osawrite(fid,LINE.STR,(int)strlen(LINE.STR));
               }
            cpntr += 8;
            }

         CONTXT.STACK = 0;                      /* now no more context there */
         mm = MAX_CONTXT * 8;
         CGN_FILL(cpntra,' ',mm);

         (void) osaclose(fid);
         if (jj > 0)                           /* so we found a context */
            {
            (void) strcpy(LINE.STR,"@@ middummclear.prg");
            goto send_command;
            }
         else
            return (1);
         }
      else
         {                                      /* search for context name */
         if (TOKEN[1].LEN < 8)
            {                                           /* pad with blanks */
            for (nr=TOKEN[1].LEN; nr<8; nr++)
                cbuf[nr] = ' ';
            }
         cpntr = cpntra;
         for (nr=0; nr<MAX_CONTXT; nr++)
            {
            if (strncmp(cpntr,cbuf,8) == 0)
               {
               jj = nr;
               goto clear_context;
               }
            cpntr += 8;
            }

         ERRORS.INDEX = 1;                      /* context name not found */
         ERRORS.SYS = 100;
         return (-1);
         }
      }
   else
      {
      for (nr=0; nr<MAX_CONTXT; nr++)           /* search context queue */
         {                                      /* for last context no. */
         if (CONTXT.QUEUE[nr] == 0)
            {
            if (nr == 0)                        /* no context enabled */
               {
               CONTXT.STACK = 0;                /* just for safety */
               return (1);
               }
            jj = CONTXT.QUEUE[nr-1] - 1;                /* last context - 1 */
            break;
            }
         }
      }


   /*  now clear single entry in CONTXT.NAME */

  clear_context:
   cpntr = cpntra + (8*jj);
   (void) strncpy(TOKEN[1].STR,cpntr,8);
   TOKEN[1].STR[8] = ' '; 
   m = CGN_INDEXC(TOKEN[1].STR,' ');
   (void) strcpy(&TOKEN[1].STR[m],".ctx"); 
   m = CGN_COPY(&LINE.STR[15],TOKEN[1].STR) + 15;
   LINE.STR[m++] = ' ';
   (void) strcpy(&LINE.STR[m],CONTXT.pdirec[jj]);
   CGN_FILL(cpntr,' ',8);
   if (CONTXT.pdirec[jj] != (char *) 0) 
      {
      (void) free(CONTXT.pdirec[jj]);
      CONTXT.pdirec[jj] = (char *) 0;
      }
   jj ++;
   CLEANCOM(jj);                                /* clear context commands */


   /* now remove context no. from queue + get top of queue as last context */

   for (nr=0; nr<MAX_CONTXT; nr++)        /* clear context queue */
      {
      if (CONTXT.QUEUE[nr] == jj)
         {
         mm = MAX_CONTXT - 1;                   /* last index */
         for (n=nr; n<mm; n++)                  /* shift down */
            {
            CONTXT.QUEUE[n] = CONTXT.QUEUE[n+1];
            if (CONTXT.QUEUE[n] == 0)
               {
               if (n == 0) CONTXT.STACK = 0;    /* just for safety */
               break;
               }
            }
         CONTXT.QUEUE[mm] = 0;                  /* always clear last entry */
         break;
         }
      }
   }

send_command:
LINE.LEN = (int) strlen(LINE.STR);
ERRORS.SYS = PARSE(1,0,0);
if (ERRORS.SYS != 0)
  return (1);
else
  return (0);
}