/* @(#)prepc1.c	17.1.1.2 (ESO-DMD) 02/25/02 17:53:03 */
/*===========================================================================
  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 module PREPC1  +++++++++++++++++++++
.LANGUAGE  C
.IDENTIFICATION	Module PREPC1
.AUTHOR		K. Banse                  ESO - Garching
.KEYWORDS
 MIDAS monitor
.COMMENTS
  holds ishostcom, break_line, MYBATCH
.VERSION [1.00]	870722: initial version built on FORTRAN version 4.40
                        as of 870311
 020204		last modif

-----------------------------------------------------------------------------*/

 
#include <fileexts.h>
 
#include <osyparms.h>
#include <monitdef.h>
#include <midback.h>

#include <stdlib.h>

void fixout();

/*

*/
 
int ishostcom(string)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  test, if command is Midas or Host command
.ALGORITHM
  if 1. non-blank char. is `$' it's a Host com.
  else try to translate + see if it's a Midas command
  if not recognized return Host com
.RETURNS
  1 = host command
  0 = Midas command
------------------------------------------------------------------*/

char *string;		/* IN: line to be checked */

{
int   defset, n, m, nbra;

char  *mypntr, mybuf[60];
char  command[6], qualif[4], defqual[4];
register char  *kpntr, cc;



mypntr = string;

while ((cc = *mypntr) != '\0')
   {
   if ((cc != ' ') && (cc != '\t'))
      {
      if (cc == '$') return 1;		/* Yes, it's a Host command */

      if ((cc == '@') || (cc == '-')) 
         return 0;		/* No, Midas procedure, Midas-host cmnd */
   
      kpntr = mypntr;
      m = 1;				/* counter of comm/qualif string */

kloop:
      kpntr++;
      if ((*kpntr == '\0') || (*kpntr == ' ') || (*kpntr == '\t')) 
         {					/* end of token reached */
         (void) memcpy(mybuf,mypntr,(size_t)m);
         mybuf[m] = '\0';
         EXTRACOM(mybuf,command,qualif);
         if (command[0] != '\0')
            {
            m = FINDCOM(command,qualif,defqual,&defset,&nbra,&mypntr,&n);
            if (m < 2)
               {
               if ((nbra > -1) && (*mypntr == '$'))
                  return 1;
               else
                  return 0; 
               }
            }
         return 1;			/* not recognized as Midas command */
         }

      if (++m < 60)
         goto kloop;
      else
         return 1;
      }

   mypntr ++;				/* skip over white space */
   }

return 1;
} 

/*

*/
 
int break_line(more_flag,rmaind)
int   *more_flag;	/* IN/OUT: indicates if we have several commands 
				   on the line */
char  *rmaind;		/* IN/OUT: buffer holding the remainder (if any) 
				   of the command line */
/* return -1 if only comment line, else return value > 0 */

{
register int  nr;
int     ist, apo_mode, apo_off, kk, iwb;
static int  pipeflag = 0;

register char sngc;
static char  pipo[12] = "1234567890";
static char  Mpipe[12] = "Mid   Pipe ";		/* length = 11 */



if (*more_flag != 0) 		/* get next command from saved remainder */
   {
   if (*rmaind == '^')
      {
      pipeflag ++;
      LINE.LEN = CGN_COPY(LINE.STR,rmaind+1);
      }
    else
      LINE.LEN = CGN_COPY(LINE.STR,rmaind);
   *more_flag = 0;
   }
else
   pipeflag = 0;

   
iwb = -1;
apo_mode = -1;                          /* after first '"' apo_mode = 1 */
apo_off = 0;

loop1:
for (nr=apo_off; nr<LINE.LEN; nr++)
   {
   sngc = LINE.STR[nr];

   if (sngc == '"')
      {
      apo_mode = -apo_mode;                 /* reset mode */
      if (apo_mode == 1) apo_off = nr;
      }

   else if ((apo_mode == 1) || (sngc == ' '))
      goto loop_end;

   else if (sngc == '\t')
      {
      LINE.STR[nr] = ' ' ;
      goto loop_end;
      }

   else if (sngc == '!')
      {
      if (iwb > 0) 				/* then nr > 0 !  */
         {
         kk = nr - 1;
         if (LINE.STR[kk] == ' ')		/* cut off at comments */
            {
            LINE.LEN = kk;
            LINE.STR[kk] = '\0';
            goto end_job;
            }
         }
      else
         return (iwb);				/* only comments ... */
      }

   else if (sngc == ';')
      {
      if (iwb < 0)
         {
         ist = nr + 1;
         LINE.LEN -= ist;			/* omit very 1. `;' */
         (void) memcpy(LINE.STR,&LINE.STR[ist],(size_t)(LINE.LEN+1));
         }
      else
         {
         register int mr, pa, pb;

         kk = nr - 1;
         pa = 0; pb = 0;
         for (mr=kk; mr>-1; mr--)
            {
            if (LINE.STR[mr] == ')') pb ++;
            if (LINE.STR[mr] == '(') pa ++;
            }
         if (pa > pb) goto loop_end;		/* ignore ';' in (..) */

         if (LINE.STR[kk] == '\\') 
            {
            (void) strcpy(&LINE.STR[kk],&LINE.STR[nr]);
            LINE.LEN -- ;
            apo_off = nr;			/* start here in next run */
            }
         else					/* single `;' found */
            {					/* save remaining part */
            (void) strcpy(rmaind,&LINE.STR[nr+1]);
            LINE.LEN = nr;
            LINE.STR[nr] = '\0';
            *more_flag = nr;
            goto end_job;
            }
         }
      goto loop1;				/* start again */
      }

   else if (sngc == '|')		/* also, look for | (pipe) */
      {
      if (LINE.STR[nr+1] == ' ')	/* YES */
         {
         Mpipe[3] = FRONT.DAZUNIT[0];
         Mpipe[4] = FRONT.DAZUNIT[1];
         Mpipe[5] = pipo[pipeflag];
         ist = ishostcom(LINE.STR);
         kk = ishostcom(&LINE.STR[nr+2]);
         if (ist == 0)		/* Midascom `|' Hostcom/Midascom */
            {		
            rmaind[0] = '^';			/* indicate <MidasPipe ... */
            (void) strcpy(&rmaind[1],&LINE.STR[nr+2]);   /* add last part */
            LINE.STR[nr++] = '>';
            (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
            LINE.LEN = (int)strlen(LINE.STR);
            *more_flag = nr;
            goto end_job;
            }
         else 
            {
            if (kk == 0)		/* Hostcom `|' Midascom */
               {
               rmaind[0] = '^';			/* indicate <MidasPipe ... */
               (void) strcpy(&rmaind[1],&LINE.STR[nr+2]);   /* add last part */
               LINE.STR[nr++] = '>';
               (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
               LINE.LEN = (int)strlen(LINE.STR);
               *more_flag = nr;
               goto end_job;
               }
            else			/* Hostcom `|' Hostcom */
               {
               if (pipeflag == 1)
                  {			/* insert input file before `|' */
                  (void) strcpy(rmaind,&LINE.STR[nr]);
                  LINE.STR[nr++] = ' ';
                  LINE.STR[nr++] = '<';
                  Mpipe[5] = pipo[pipeflag-1];
                  (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
                  (void) strcat(LINE.STR,rmaind);
                  LINE.LEN = (int)strlen(LINE.STR);
                  pipeflag = 0;
                  }
               else if (LINE.STR[nr+2] == '$')
                  LINE.STR[nr+2] = ' ';		/* remove the `$' char. */
               }
            }
         }
      }

   iwb = 1;				/* all "normal" chars. end up here */

loop_end:
   ;
   }

if (apo_mode == 1)                      /* was just a single '"' */
   {
   apo_off ++;
   apo_mode = -1;	/* avoid infinite loop, if `"' very last char.! */
   goto loop1;
   }
   
end_job:
if (pipeflag != 0)
   {
   Mpipe[5] = pipo[pipeflag-1];			/* pipe from last time */
   for (nr=LINE.LEN-2; nr>0; nr--)		/* omit trailing blank */
      {
      if (LINE.STR[nr] == ' ') 
         { 
         if (LINE.STR[nr+1] == '>')
            {
            if (LINE.STR[nr+2] == '>')
               sngc = CGN_UPPER(LINE.STR[nr+3]);
            else
               sngc = CGN_UPPER(LINE.STR[nr+2]);
            if ((sngc >= 'A') && (sngc <= 'Z'))
               {
               char savbuf[200];

               (void) strcpy(savbuf,&LINE.STR[nr]);
               LINE.STR[nr++] = ' ';
               LINE.STR[nr++] = '<';
               (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
               (void) strcat(LINE.STR,savbuf);
               LINE.LEN = (int) strlen(LINE.STR);
               return (iwb);
               }
            }
         break;
         }
      }

   nr = LINE.LEN;
   LINE.STR[nr++] = ' ';
   LINE.STR[nr++] = '<';
   (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
   LINE.LEN += 13;		/* 2 + 11 (= size of Mpipe) */
   }
return (iwb);
}

/*

*/
 
void MYBATCH(cmd,procedu)
 
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  1) compile program - @ (@@) or # command
  2) get next command line in "program" mode - NX command
  3) execute a "batch" command (like *GO, *INC) - N* command
.ALGORITHM
  store program/batch file internally + execute it
  save procedure level also in key MODE(7)
.RETURNS
  nothing
-------------------------------------------------------------------------*/
 
char	*cmd;		/* IN: @ or @% or @@ or #A, #C, #S or NX, N* ... */
char	*procedu;	/* IN: name of procedure, if needed */

{
register int nr;
int   ibuf[20], ikey, lstep, looplim;
int   lengthCode, m, mm, n, nn, offset, offset1, off_limit;
int   prcnt, stat, reclen, igoto, lcount, slen;
int   iwa, iwb, echo, fp;
int   xt, mdebug, more_cmnds, unit, iav, nullo;
static int   perror;
static int   Mbreak[5] = {-1,-1,-1,-1,-1};
static int   Mbreaklabl[5] = {-1,-1,-1,-1,-1};
static int   Mdbindx, Mdbcount = -1, *Mdbline, *Mdbptr, Mdbstep;

char    save[MAX_LINE], *cptr, string[MAX_LINE], keyname[18];
char    label[24], compile_flag[2], k_type[4];
char    trans_name[64];
register char  *tptr, *sptr, firstch, cc;
static char  asci[9] = {'0','1','2','3','4','5','6','7','8'};

float   rwa, rkey;
double  dwa, dkey;





 
/*  find out what to do   */
 
perror = 1; 
if (*cmd == 'N')
   {
   if (KIWORDS[OFF_PRSTAT] > 0)		/*  test key PROGSTAT(1)  */
      {
      iwa = KIWORDS[OFF_ERROR+2];
      if ( (iwa == 0) ||
           ( (iwa != -1) && (iwa != KIWORDS[OFF_PRSTAT]) ) )
         {
         MONIT.LEVEL = 1;			/* if PROGSTAT  !=  0  */
         goto sect_3300;			/* abort procedure...!   */
         }
      }
   goto execute;				/* jump to execute section  */
   }
 
 
/* ........................................................................ */
	
/*             compilation of MIDAS procedure                               */
	
/* ........................................................................ */
	
 

compile_flag[0] = *cmd;			/* save @, @@ or #A or #S  */
compile_flag[1] = *(cmd+1);
if (compile_flag[0] == '#') 
   {
   if (compile_flag[1] != 'C') 
      (void) strcpy(trans_name,TOKEN[1].STR);
   if (compile_flag[1] == 'S') 
      {
      MONIT.COMPILED = 0;		/* force it back to not-compiled */
      CGN_UPSTR(TOKEN[2].STR);
      if (TOKEN[2].STR[0] == 'X') 
         {
         if ((TOKEN[2].STR[1] == ',') && (TOKEN[2].STR[2] == 'S'))
            xt = 2;
         else
            xt = 1;
         }
      else
         xt = 0;
      }
   }
lcount = 0;				/* clear line count */
	
iwa = ++ MONIT.LEVEL;			/* MONIT.LEVEL in [1,10]  */
if (iwa > MAX_LEVEL)		/* max. MAX_LEVEL levels of are supported  */
   {	
   ERRORS.SYS = 20;
   goto badcompile;
   }

MONIT.MXT[iwa] = MONIT.MXT[iwa-1];		/* inherit timeout */
if (MONIT.MXT[iwa] > 0)
   {
   long int ltime, oshtime();

   if (iwa > 1)	
      {
      MONIT.ENDT[iwa] = MONIT.ENDT[iwa-1];	/* and end time */

      if ((ltime=oshtime()) >= MONIT.ENDT[iwa])
         {					/* already timed out ... */
         (void) sprintf(string,
                "(ERR) Midas procedure %s timed out (%d seconds)",
                PROC.FNAME,MONIT.MAXTIME);
         SCTPUT(string);
         KIWORDS[OFF_PRSTAT] = 998;
         KIWORDS[OFF_PRSTAT+1] = 10;
         MONIT.LEVEL = 1;		/* force return to interactive level */
         goto sect_3300;
         }
      }
   else
      MONIT.ENDT[iwa] = oshtime() + MONIT.MXT[iwa];  /* calculate end time */
   }

stat = CODE_ALLOC(0);                /* create with default size */
off_limit = CODE.LEN - 2;		/* hi limit of code  */
if (stat != 0)
   {
   ERRORS.SYS = 25;
   goto badcompile;
   }


/*  check, if we use same code again */

if (MONIT.LEVEL <= MONIT.TOPLEVL)
   {  
   m = CODE_PRNAME + 8;
   iwa = strcmp(PROC.FNAME,&CODE.CODE[m]);
   if (iwa == 0)
      {
      if (strncmp(PROC.ENTRY,&CODE.CODE[CODE_PRNAME],8) == 0)
         {
         MONIT.COMPILED = 1;
         goto file_ok;
         }
      }
   }


doit_again:
*(CODE.CODE+CODE_START) = '\r';          /* set first char. of code to '\r' */

	
/*  open procedure file or get already compiled code from internal.cod  */
 
if (MONIT.COMPILED == 0)
   {
   ERRORS.SYS = 79;
   fp = osaopen(procedu,0);	       /*  means reading only */
   if (fp == -1) 
      {				       /* try to open in CPATH directories  */
      if (*(cmd+1) != '@') 
         goto badcompile;		/* but only for @@ command */

      for (nr=0; nr<4; nr++)
         {
         if (CPATH[nr].STR[0] != '\0') 
            {
            (void) strcpy(string,CPATH[nr].STR);
            (void) strcat(string,procedu);
            fp = osaopen(string,0);
            if (fp != -1) goto open_ok;
            }
         }
      if (fp == -1) goto badcompile;		/* now it's really bad ... */
      }
 
  open_ok:
   if (PROC.ENTRY[0] != ' ')
      {
      for (nr=7; nr>0; nr--)
          {
          if (PROC.ENTRY[nr] != ' ')
             break;
          }
      slen = nr + 1;
      iwa = slen + 6;				/* length of "ENTRY name"   */
 
ent_loop:
      lcount ++;
      reclen = osaread(fp,string,MAX_LINE);     /* look for: ENTRY proc_entry */
      if (reclen == 0)
         goto ent_loop;
      else if (reclen < 0)
         {
         osaclose(fp);
         ERRORS.SYS = 18;		/* procedure entry couldn't be found */
         goto badcompile;
         }
 
      for (nr=0; nr<=(reclen-iwa); nr++)
         {
         if ( (string[nr] != '\t') && (string[nr] != ' ') )
            {
            if ( (strncmp(&string[nr],"ENTRY",5) != 0) &&
                 (strncmp(&string[nr],"entry",5) != 0) ) goto ent_loop;
    
            nr += 6;              /* skip over `ENTRY' + following blanks */
            while ( (string[nr] == '\t') || (string[nr] == ' ') ) nr++;

            CGN_UPCOPY(save,&string[nr],8);
            if ( (strncmp(save,PROC.ENTRY,slen) == 0) ||
                 (save[0] == '*') )          /* matching or wild card entry */
               goto file_ok;
      
            break;					/* get out of loop */
            } 
         }
      goto ent_loop;				/* catch blank line ...  */
      }
   }
else
   {
   save[0] = 'F';
   stat = INTERNAL(save,TOKEN[1].STR,&lengthCode);	/* get compiled code */
   if (stat != 0)
      {
      ERRORS.SYS = 22;
      if (stat == 2)			/* internal.cod not opened */
         {
         (void)printf("MID_PROC:internal.cod could not be opened...\n");
         (void)printf("do  '@ compile.all'  to create a new internal.cod\n");
         MONIT.LEVEL = 1;		/* force exit */
         goto badcompile_1;
         }
      else
         goto badcompile;
      }
   if (lengthCode >= off_limit) 	   /* for compiled code no overflow! */
      {
      ERRORS.SYS = 25;
      goto badcompile;
      }
   }

	
/*  file open o.k. */
 
file_ok:
 
if (MONIT.PDEBUG[MONIT.LEVEL] == 2)
   MONIT.PDEBUG[MONIT.LEVEL] = 1;		    /* reset debugging flag  */
for (nn=MONIT.COUNT; nn>2; nn--)
   {
   nr = nn - 1;				/* move to C-indexing */
   if ((TOKEN[nr].STR[0] != '?')
      ||
      (TOKEN[nr].STR[1] != '\0'))
      {
      MONIT.COUNT = nn;
      break;
      }
   }
*CODE.CODE = asci[MONIT.COUNT-2];	 /* save no. of actual pars in proc. */
CROSS_PARM();			/* store passed parameters in crossref table */
					/* hold this line until we SAVE_PARM */
(void) memcpy(save,LINE.STR,(size_t)(LINE.LEN+1));
	

/*  initialize default area  */
 
(void) 
memcpy((CODE.CODE+CODE_DEFS),"?\r?\r?\r?\r?\r?\r?\r?\r\r",(size_t)17);
nn = MONIT.LEVEL * 15;
(void) 
memcpy(&PROC.FORMAT[nn],"4.4  15.5 15.5 ",(size_t)15);	/* init FORMATs */

if (MONIT.COMPILED == 1)
   goto final_save;		/* if compiled code, we're already done */
    

/* check for individually compiled procedure */

offset = CODE_START;		/* code starts at position CODE_START */

nn = (int) strlen(procedu);
if (nn > 3) 
   {				/* look for name.prg_o */
#if vms
   if ((procedu[nn-1] == 'O') &&
       (procedu[nn-2] == '_') &&
       (procedu[nn-3] == 'G'))
#else
   if ((procedu[nn-1] == 'o') &&
       (procedu[nn-2] == '_') &&
       (procedu[nn-3] == 'g'))
#endif
      {				/* Yes, we already have the compiled code */
      reclen = osaread(fp,string,MAX_LINE);	/* get size of code */
      if (reclen < 1) goto badcompile_1;

      iwa = -1;
      iwa = atoi(string);
      if (iwa < 1) goto badcompile_1;

     lim_check:
      if (iwa >= off_limit)                   /* CODE overflow?  */
         {
         nn = CODE.LEN + CODE.LEN;            /* take twice the current size */
         if (CODE_ALLOC(nn) == 0)
            {				      /* also updates CODE.LEN */
            off_limit = CODE.LEN - 2;         /* new high limit of code  */
            (void) memcpy((CODE.CODE+CODE_DEFS),    /* CODE_ALLOC() clears! */
                          "?\r?\r?\r?\r?\r?\r?\r?\r\r",(size_t)17);
            goto lim_check;
            }
         ERRORS.SYS = 25;		      /* problems with malloc ... */
         goto badcompile;
         }

     opt_loop:
      reclen = osaread(fp,&CODE.CODE[offset],MAX_LINE);
      if (reclen < 1)
         {
         CODE.CODE[offset++] = '\r';
         CODE.CODE[offset] = '\0';
         lengthCode = offset;
         (void) osaclose(fp);
         goto final_save;
         }
      else
         {
         offset += reclen;
         CODE.CODE[offset++] = '\r';
         goto opt_loop;
         }
      }
   }


(void) COMPILE(8,&iwa);		         /* init COMPILER ... */
more_cmnds = 0;			/* indicates, if more commands on a line */
 
rd_init: 			/*  now work line by line...  */
nn = 0;
if (more_cmnds > 0)
   {
   mm = break_line(&more_cmnds,string);
   if (mm != (-1)) goto start_parser;		/* drop comment line */
   }

rd_loop:
lcount ++;
reclen = osaread(fp,string,MAX_LINE);		/* read a record from file */
 
if (reclen < 1)
   {
   if (reclen < 0)
      goto eof_found;				/*  EOF encountered  */
   else
      goto rd_loop;				/* empty line */
   }

if ( (string[0] == '!') && (nn == 0) )
   goto rd_loop;			/* catch comments already here  */
 
if ((reclen + nn) >= MAX_LINE)
   {				/* check length of combined input line */
   ERRORS.SYS = 29;
   goto badcompile;
   }

(void) memcpy(&LINE.STR[nn],string,(size_t)(reclen+1));
LINE.LEN = reclen + nn;
if (string[reclen-1] == '-') 			/* continuation lines?  */
   {
   for (nr=0; nr<reclen-1; nr++)		/* test for " !" first... */
      {
      if (string[nr] == '!')
         {
         if (nr == 0)
            goto no_cont;
         else
            {
            iwa = nr - 1;
            if ((string[iwa] == ' ') ||
                (string[iwa] == '\t'))		/* tab instead of blank */
            goto no_cont;
            }
         }
      }

   nn = LINE.LEN - 1;			/* drop continuation character  */
   goto rd_loop;
   }
 
no_cont:
LINE.STR[LINE.LEN] = '\0';
more_cmnds = 0;
mm = break_line(&more_cmnds,string);
if (mm == -1) goto rd_init;             /* drop comment line */
	

/*  now parse command line stored in LINE.STR  */
 
start_parser:
ERRORS.SYS = PARSE(0,0,0);			 	/* raw parsing  */
if (ERRORS.SYS != 0) 
   {
   perror = 0;
   goto badcompile;
   }
 
if (MONIT.COUNT < 1) goto rd_init;			/* nothing there */
	
	
/*  look for commands which have to be compiled  */
 
tptr = TOKEN[0].STR;
firstch = *tptr;

if ( (firstch != '$') &&          /* avoid Host + immediate commands */
     ((TOKEN[1].STR[0] != '=') || (TOKEN[1].LEN != 1)) )
   {
   CGN_UPSTR(tptr);
 
   if (TOKEN[0].STR[TOKEN[0].LEN-1] == ':')	/* first, test for labels */
      {
      if ( (MONIT.COUNT > 1) ||		/* nothing else should be there... */
           ((firstch >= '0') && (firstch <= '9')) )
         {
         ERRORS.SYS = 25;
         goto badexec;
         }

      iwa = offset + TOKEN[0].LEN + 1;
      goto after_add_star;
      }

   else
      {
      if (strcmp(tptr,"END") == 0)	/* look for END IF, END DO */
         {
         CGN_UPCOPY(KAUX.STR,TOKEN[1].STR,3);
         if (KAUX.STR[2] == '\0') 
            {
            if ((KAUX.STR[0] == 'D') && (KAUX.STR[1] == 'O'))
               {
               *(tptr+3) = 'D';
               *(tptr+4) = 'O';
               *(tptr+5) = '\0';
               }
            else if ((KAUX.STR[0] == 'I') && (KAUX.STR[1] == 'F'))
               {
               *(tptr+3) = 'I';
               *(tptr+4) = 'F';
               *(tptr+5) = '\0';
               }
            }
         }
      for (n=0; n<MAX_BATCH; n++)
         {
         if (strcmp(tptr,BATCH[n].CMND) == 0)
            {
            iwa = offset;			/* check for CODE overflow */
            for (nr=0; nr<MONIT.COUNT; nr++) 
               iwa += TOKEN[nr].LEN;
            iwa += 64;			/* add space for expansion */
            if (iwa >= off_limit)		/* in COMPILE */
               goto after_add_star;
   
            ERRORS.SYS = COMPILE(n,&offset);
            if (ERRORS.SYS == 0) 		/* check for syntax errors  */
               goto rd_init;		/* all o.k. - get next line  */
             
            perror = 0;			/* something wrong... */
            goto badcompile;
            }
         }
      }
 

/*  if first token is ENTRY, treat it like an EOF  */
 
   if (strcmp(tptr,"ENTRY") == 0)
      goto eof_found;
 

/*  look for  GOTO, PAUSE, BRANCH, CROSSREF, RETURN + preprocess it  */
 
   if ( (strcmp(tptr,"GOTO") == 0) ||
        (strcmp(tptr,"BRANCH") == 0) ||
        (strcmp(tptr,"CROSSREF") == 0) )
      goto add_star;

   if (strcmp(tptr,"PAUSE") == 0) 
      {
      char  tempy[40];

      nn = CGN_COPY(tempy,"move/local out^*PA^^");
      iwa = offset + nn;
      if (iwa >= off_limit) 		      /* CODE overflow?  */
         goto after_add_star;

      for (nr=0; nr<nn; nr++)
         {
         if (tempy[nr] == '^') tempy[nr] = '\r';
         }
      (void) strcpy(&CODE.CODE[offset],tempy);
      offset += (nn - 1);
      goto rd_init;
      }

   if (strncmp(tptr,"RETURN",6) == 0)
      {
      if ( (*(tptr+6) == '/') && (*(tptr+7) == 'E') )
         *(tptr+1) = 'X';			/* take care of RETURN/EXIT  */

add_star:
      *(tptr+2) = *(tptr+1);
      *(tptr+1) = *tptr;
      *tptr = '*';
      TOKEN[0].LEN = 3;
      }
   }

	
/*  now fill CODE with command string  */
 
iwa = offset;
for (nr=0; nr<MONIT.COUNT; nr++) iwa += TOKEN[nr].LEN;
iwa += MONIT.COUNT;			/* we also need that many blanks */

after_add_star:
if (iwa >= off_limit)			/* CODE overflow?  */
   {
   nn = CODE.LEN + CODE.LEN;		/* take twice the current size */
   stat = CODE_ALLOC(nn);
   off_limit = CODE.LEN - 2;		/* hi limit of code  */
   if (stat != 0)
      {
      ERRORS.SYS = 25;
      goto badcompile;
      }
   else
      {
      (void) osaclose(fp);
      LINE.LEN = CGN_COPY(LINE.STR,save);	/* get back original */
      (void) PARSE(1,0,0);				/* line ... */
      goto doit_again;
      }
   }

for (nr=0; nr<MONIT.COUNT; nr++)
   {
   mm = TOKEN[nr].LEN;
   (void) memcpy(&CODE.CODE[offset],TOKEN[nr].STR,(size_t)mm);
   offset += mm;
   CODE.CODE[offset++] = ' ';
   }
 
CODE.CODE[offset-1] = '\r';
CODE.CODE[offset] = '\r';
CODE.CODE[offset+1] = '\0';
goto rd_init;
	

/*  EOF encountered  */
 
eof_found:

(void) osaclose(fp);
stat = COMPILE(9,&offset);		/* check nesting levels...  */
if (stat != 0)
   {
   perror = 0;
   ERRORS.SYS = 28;
   goto badcompile;
   }
lengthCode = offset + 1;			/*  get length of code  */

	
/* save final parameters in keys P1 ... P8  */
 
final_save:                              /*  save program counters  */
ERRORS.SYS = SAVE_PARM(1,MONIT.LEVEL,&nn);
if (ERRORS.SYS != 0)
   {
   (void) strncpy(LINE.STR,save,80);
   LINE.LEN = 80;
   LINE.STR[LINE.LEN] = '\0';
   goto badcompile;
   }


/* set PC for higher level to start of code */

MONIT.PCODE[MONIT.LEVEL-1] = nn; 
 

/* now check for debug mode */

if ((MONIT.PDEBUG[MONIT.LEVEL] > 0) && (compile_flag[0] != '#'))
   {
   MONIT.PDEBUG[MONIT.LEVEL] = 1;		/* force to stepwise mode */
   if (Mdbcount == -1)
      {						/* allocate space for */
      char  *pbuf;				/* Mdb line count */

      pbuf = malloc((unsigned int)CODE.LEN);
      if (pbuf == (char *) NULL)
         {
         (void) printf("could not allocate memory for Mdbline ...\n");
         MONIT.PDEBUG[MONIT.LEVEL] = 0;		/* reset switch */
         goto after_Mdbcount;
         }
      Mdbptr = (int *) pbuf;		/* points to allocated space */
      }

   /* fill array Mdbline with offsets (in CODE.CODE) for each line */

   Mdbstep = 0;				/* no. of steps in `step' command */
   Mdbline = Mdbptr;
   Mdbcount = 0;			/* reset the line counter */
   iwa = CODE_START;

   if (strncmp(&CODE.CODE[iwa],"*CR",3) == 0)	/* check, if CROSSREF cmnd */
      {
      nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');	/* Yes, so skip it */
      iwa += (nn + 1);
      }

  Mdb_loop1:
   nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');
   if (nn > 0)
      {
      *Mdbline++ = iwa;			/* save offset of CODE.CODE */
      Mdbcount ++;
      iwa += (nn + 1);
      goto Mdb_loop1;
      }

   for (nr=0; nr<5; nr++)			/* clear breakpoints */
      {
      if (Mbreak[nr] >= MONIT.LEVEL)
         Mbreak[nr] = -1;			/* reset it */
      }
   (void) 
   printf("\nMidas debugger (Mdb) running procedure `%s' with  %d lines\n\n",
          procedu,Mdbcount);
   }
 
 
/*  if we compile,  call INTERNAL with A(dd) option  */
 
after_Mdbcount:
if (compile_flag[0] != '#')
   {
   KIWORDS[OFF_MODE+6] = MONIT.LEVEL;      /* update MODE(7) for local keys  */
   (void) strncpy(&CODE.CODE[CODE_PRNAME],PROC.ENTRY,8);       /* save entry */
   m = CODE_PRNAME + 8;
   (void) strncpy(&CODE.CODE[m],PROC.FNAME,80);   /* and name of procedure */
   CODE.CODE[m+80] = '\0';			    /* limit to 80 chars.    */
   return;
   }



if (compile_flag[1] == 'S')			/* handle TRANSLATE/SHOW */
   {
   char    type[4];
   int     tokovf, bad;

   offset = CODE_START;
   tokovf = 0;				/* TOKEN overflow flag */
   iwb = 0;				/* error count */

 show_loop: 				/* find end of current command line */
   mm = CGN_INDEXC(&CODE.CODE[offset],'\r');
   if (mm < 1) 					/* end of procedure */
      {
      int  warn[2];

      if (xt == 0)
         {
         SCTPUT("----------------");
         (void) sprintf(LINE.STR,"total length = %d chars",offset);
         SCTPUT(LINE.STR); 
         }

      CGN_CLEANF(trans_name,6,KAUX.STR,64,&nn,&nn);
      if (iwb > 0)
         {
         (void) sprintf(LINE.STR,"%s: %d warnings encountered ...",
                        KAUX.STR,iwb);
         SCTPUT(LINE.STR);
         }
      if (tokovf > 0)
         {
         (void) sprintf(LINE.STR,"%s: %d severe warnings encountered ...",
                        KAUX.STR,tokovf);
         SCTPUT(LINE.STR);
         }
      warn[0] = iwb + tokovf;
      warn[1] = tokovf;
      if ((warn[0] == 0) && (xt != 2))
         {
         (void) sprintf(LINE.STR,"%s: all o.k. ",KAUX.STR);
         SCTPUT(LINE.STR); 
         }

      (void) SCKWRI("MID$INFO",warn,1,2,&unit);
      goto sect_2300;		/* move back up */
      }
   

   /* now check the comm/qualif string */

   (void) strncpy(LINE.STR,&CODE.CODE[offset],mm);
   LINE.STR[mm] = '\0';
   LINE.LEN = mm;

   nn = PARSE(-1,0,0);		/* parse again to get TOKEN structure filled */
   if (nn == -99)
      {					/* suspicious ... */
      if ( ((TOKEN[1].STR[0] == '=') && (TOKEN[1].LEN == 1)) 
           || (TOKEN[0].STR[0] == '$') )
         goto after_99;

      if (xt != 2)
         {
         (void) strcpy(string,"----- more than 10 TOKEN in line: ");
         SCTPUT(string);
         SCTPUT(LINE.STR);
         SCTPUT(" " );
         }
      tokovf ++;
      goto do_show_loop;
      }

  after_99:
   if (xt == 0)
      {
      SCTPUT(LINE.STR); 
      offset += (mm + 1);
      goto show_loop;
      }

   bad = 0;
once_more_1:
   cptr = LINE.STR;
   type[0] = '"';
   type[1] = '{';
   type[2] = '\0';
   m = CGN_INDEXS(cptr,type);
   if ((m > 0) && (*(cptr+m-1) != ' ') && (*(cptr+m-1) != '{') )
      {
      n = CGN_INDEXC(cptr,'}');
      if ((n > m) && (*(cptr+n+1) == '"'))
         {
         int  unit, sbytelem, snoelem;
         long int since;

         nn = m + 2;
         (void) strncpy(string,cptr+nn,n-nn);
         string[n-nn] = '\0';
         if ( (CGN_INDEXC(string,',') > 0) ||
              (CGN_INDEXC(string,'[') > 0) ) goto do_show_loop;
 
         nn = MID_FNDKEY(string,type,&sbytelem,&snoelem,&since,&unit); 
         if ( ((nn == -1) || (type[0] == 'C')) ||
              (CGN_INDEXS(cptr,"M$") > 0) )
            {
            if (bad == 0)
               {
               bad = 1;
               iwb ++;
               if (xt == 1)
                  {
                  SCTPUT(LINE.STR);
                  SCTPUT("----- bad coding style");
                  }
               }
            (void) strcpy(string,cptr);
            (void) strcpy(&string[m],cptr+m+2);
            if (*(cptr+n+2) == '\0')
               string[n-2] = '\0';
            else
               (void) strcpy(&string[n-2],cptr+n+2);
            (void) strcpy(LINE.STR,string);
            goto once_more_1;
            }
         }
      }
   if (bad == 1)
      {
      bad = 0;
      if (xt == 1)
         {
         (void) strcpy(string,"----- should be: ");  /* length = 17 */
         (void) strcpy(&string[17],cptr);
         SCTPUT(string);
         }
      goto do_show_loop;
      }

   if ((*cptr == '$') || (*cptr == '-') || 
       (*cptr == '@') || (*cptr == '*') || (*(cptr+1) == ','))
      goto do_show_loop;		/* skip special commands */

   nn = CGN_INDEXC(cptr,' ');
   if (nn > 0)
      {				/* check for immediate commands */
      if ((*(cptr+nn+1) == '=') && (*(cptr+nn+2) == ' '))
         goto compkey_check;
      }
   else 
      nn = mm;

   if (*(cptr+nn-1) == ':') goto do_show_loop;	/* avoid labels */

   (void) strncpy(string,cptr,nn);
   string[nn] = '\0';
   EXTRACOM(string,save,label);
   (void) strncpy(&save[10],save,6);
   (void) strncpy(&label[10],label,4);
   if (label[10] == ' ')
      {
      for (nr=0; nr<6; nr++)
         {
         if (save[nr] == '{') goto do_show_loop;
         }
      if ((strncmp(save,"RUN ",4) != 0) /* if it's not RUN */
          &&
          (strncmp(save,"HELP",4) != 0)		/* nor HELP */
          &&
          (strncmp(save,"BYE ",4) != 0))        /* nor BYE */
         {
         iwb ++;
         if (xt == 1)
            {
            SCTPUT(LINE.STR);
            SCTPUT("----- command without qualifier");
            }
         goto do_show_loop;
         }
      }

   m = FINDCOM(save,label,&string[100],&n,&n,&cptr,&nn);
   if (m > 1) goto do_show_loop;		/* command not found */

   for (nr=0; nr<6; nr++)
      {
      if (save[nr] != save[10+nr])
         {
         iwb ++;
         if (xt == 1)
            {
            SCTPUT(LINE.STR); 
            SCTPUT("----- incomplete command");
            }
         goto do_show_loop;
         }
      }
   for (nr=0; nr<4; nr++)
      {
      if (label[nr] != label[10+nr])
         {
         iwb ++;
         if (xt == 1)
            {
            SCTPUT(LINE.STR); 
            SCTPUT("----- incomplete qualifier");
            }
         goto do_show_loop;
         }
      }
   if ((strncmp(save,"COMPUT",6) != 0)		/* check for COMPUTE/KEYW */
         ||
       (strncmp(label,"KEYW",4) != 0)) goto do_show_loop;

compkey_check:
   nn = CGN_INDEXS(cptr," = ");
   m = CGN_INDEXC(cptr,'{');
   if ( (m > 0) && (*(cptr+m+1) != '{') )	/* avoid nested substitutions */
      {
      char  ops[8], *kptr;
    
      kptr = cptr + nn + 3;			/* point to expression */
      (void)strcpy(ops,"+-*/");
      for (nr=0; nr<4; nr++)
         {
         if (CGN_INDEXC(kptr,ops[nr]) > 0)
            {
            n = CGN_INDEXC(cptr,'}');
            if (n > m)
               {
               int  unit, sbytelem, snoelem;
               long int since;

               nn = m + 1;
               (void) strncpy(string,cptr+nn,n-nn);
               string[n-nn] = '\0';
               if ( (CGN_INDEXC(string,',') > 0) ||
                    (CGN_INDEXC(string,'[') > 0) ) goto do_show_loop;

               nn = MID_FNDKEY(string,type,&sbytelem,&snoelem,&since,&unit);
               if ((nn == -1) || (type[0] != 'C')) 
                  { 
                  if (bad == 0)
                     {
                     bad = 1;
                     iwb ++;
                     if (xt == 1)
                        {
                        SCTPUT(LINE.STR);
                        SCTPUT("----- bad coding style");
                        }
                     }
                  (void) strcpy(string,cptr);
                  (void) strcpy(&string[m],cptr+m+1);
                  if (*(cptr+n+1) == '\0')
                     string[n-1] = '\0';
                  else
                     (void) strcpy(&string[n-1],cptr+n+1);
                  (void) strcpy(LINE.STR,string);
                  goto compkey_check;
                  }
               }
            }
         }
      }
   if ( (bad == 1) && (xt == 1) )
      {
      (void) strcpy(string,"----- should be: ");  /* length = 17 */
      (void) strcpy(&string[17],cptr);
      SCTPUT(string);
      }

do_show_loop: 
   offset += (mm + 1);
   goto show_loop;
   }

else if (compile_flag[1] == 'C')		/* handle TRANSLATE/PROC */
   {
   int  gp;

   n = KIWORDS[OFF_MONPAR+10];			/* MONITPAR(11) = debug flag */
   opti_code(&lengthCode,1,n);		/* optimized code => output0.cprg */

   fp = osaopen("output0.cprg",0);
   if (fp < 1) goto badcompile_1;

   (void) strcpy(string,procedu);		/* build procedu_o name */
   (void) strcat(string,"_o");
   gp = osaopen(string,1);
   if (gp < 1) goto badcompile_1;
   nn = sprintf(string,"%d",lengthCode);	/* first line = size of code */
   (void) osawrite(gp,string,nn);

  copy_loop:
   reclen = osaread(fp,string,MAX_LINE);
   if (reclen > 0)
      {
      (void) osawrite(gp,string,reclen);
      goto copy_loop;
      }
   (void) osaclose(fp);
   (void) osaclose(gp);
   (void) sprintf(string,"procedure %s: total length = %d chars. ",
           procedu,lengthCode);
   SCTPUT(string);				/* show total length */
   }

else
   {						 /* store compiled code */
   stat = INTERNAL(&compile_flag[1],trans_name,&lengthCode);
   if (stat != 0)
      {
      ERRORS.SYS = 40;
      if (stat == 2)			/* internal.cod not opened */
         {
         (void)printf("MID_PROC:internal.cod could not be opened...\n");
         (void)printf("do  '@ compile.all'  to create a new internal.cod\n");
         MONIT.LEVEL = 1;		/* force exit */
         goto badcompile_1;
         }
      else
         goto badcompile;
      }
   (void) sprintf(string,"procedure %s: total length = %d chars. ",
           trans_name,lengthCode);
   SCTPUT(string);				/* show total length */
   }
 

   /*  MONIT.LEVEL has to be reset ... */

sect_2300:
MONIT.LEVEL --;
if (MONIT.LEVEL > 0) 		/* if we are inside a procedure,  */
   {
   nr = MONIT.LEVEL - 1;
   CODE.CODE = TRANSLATE[nr].PNTR[0];
   CODE.LEN = TRANSLATE[nr].LEN[0];
   }
 
return;
 


badcompile:
iwa = OFF_ERROR+3;

if (perror == 1)
   {
   if (ERRORS.INDEX == -1)
      PREPERR("MIDAS",LINE.STR," ");
   else
      PREPERR("MIDAS",LINE.STR,TOKEN[ERRORS.INDEX].STR);
   }
if (KIWORDS[iwa] != 0)
   {
   (void) sprintf(string,"In Midas procedure: %s, line %d",PROC.FNAME,lcount);
   SCTPUT(string);
   }

badcompile_1:
MONIT.LEVEL --;
if (MONIT.LEVEL > 0)                 /* if we are inside a procedure,  */
   {
   nn = MONIT.LEVEL - 1;
   CODE.CODE = TRANSLATE[nn].PNTR[0];
   CODE.LEN = TRANSLATE[nn].LEN[0];
   }
return;

/*

*/
 
/*..............................................................*/
	
/*              execution of MIDAS procedures                   */
	
/*..............................................................*/
		
execute:						/*
--------						*/
offset = MONIT.PCODE[MONIT.LEVEL-1];		/* get program counter  */
echo = MONIT.ECHO[MONIT.LEVEL];
mdebug = MONIT.PDEBUG[MONIT.LEVEL];
if ((mdebug == 1) && (echo < 1))
   echo = 1;    			/* force echo for stepwise debugging */

if (*(cmd+1) == '*')
   {
   *(cmd+1) = 'X';			/*  reset the command to NX  */
   goto test_line;		/*  and go execute the stuff stored in TOKEN */
   }   
 

/* in debugging mode continue only after (some) key is hit  */

get_line:						/*
--------						*/
tptr = &CODE.CODE[offset];
sptr = LINE.STR;
for (nr=0; ;nr++)
   {						/* find end of comline */
   cc = *tptr++;
   if (cc == '\r') 
      {	
      LINE.LEN = nr;
      if (LINE.LEN < 1) goto sect_3300;		/* check for end of program */

      break;
      }
   else
      *sptr++ = cc;
   }
*sptr = '\0';

prcnt = offset + LINE.LEN + 1;			/* update PC  */

ERRORS.SYS = PARSE(2,echo,MONIT.LEVEL);	    /* parse command string  */
if (ERRORS.SYS != 0)			     /* error in parsing the string  */
   {
   perror = 0;
   goto badexec;
   }

offset1 = offset;
offset = prcnt;		      /* let 'offset' point to next command  */
 

if (mdebug > 0)
   {
   Mdbline = Mdbptr;				/* reset to begin of array */
   Mdbindx = 0;
   for (nr=0; nr<Mdbcount; nr++)
      {
      iwa = *Mdbline++;
      if (iwa == offset1)
         {
         Mdbindx = nr + 1;			/* line count starts at 1 */
         break;
         }
      }

   if (Mdbindx == 0)
      {
      printf("problems with Midas debugger - please, report it to ESO...\n");
      }

   if (mdebug == 77)
      {
      MONIT.PDEBUG[MONIT.LEVEL] = 1;		/* enable stepwise debugging */
      (void) strcpy(TOKEN[0].STR,"*PA");
      prcnt = offset;
      goto test_line; 
      }

   if (mdebug > 1) 				/* test for break point */
      {
      for (nr=0; nr<5; nr++)
         {
         if ( (Mbreak[nr] == MONIT.LEVEL) &&
              (Mbreaklabl[nr] == Mdbindx) )
            {
            (void) printf("breakpoint: %4.4d %s\n\r",Mdbindx,LINE.STR);
            goto debug_loop;
            }
         }
      goto test_line;				/* no breakpoint matches */
      }

   if (Mdbstep > 1)				/* step count */
      {
      for (nr=0; nr<5; nr++)
         {
         if ( (Mbreak[nr] == MONIT.LEVEL) &&
              (Mbreaklabl[nr] == Mdbindx) )
            {
            (void) printf("breakpoint: %4.4d %s\n\r",Mdbindx,LINE.STR);
            goto debug_loop;
            }
         }
      Mdbstep --;
      goto test_line;				/* continue */
      }
         

debug_loop:
   if (MONIT.CTRLC == 1)
      {
      MONIT.LEVEL = 1;				/* if Cntrl/C   */
      MONIT.CTRLC = 0;				/* clear flag again */
      goto sect_3300;				/* and abort procedure !   */
      }

   (void) printf("Mdb (%4.4d) > ",Mdbindx);	/* get input the standard way */
   CGN_GETLINE(string,40);

   if (string[0] == '\0') 			/* RETURN */
      {
      if (mdebug == 2)
         {
         MONIT.PDEBUG[MONIT.LEVEL] = 1;         /* enable stepwise debugging */
         mdebug = MONIT.PDEBUG[MONIT.LEVEL];
         }
      }
   else if (string[0] == 'c') 			/* continue */
      {
      MONIT.PDEBUG[MONIT.LEVEL] = 2;           /* disable stepwise debugging */
      mdebug = MONIT.PDEBUG[MONIT.LEVEL];
      }
   else if ((string[0] == 'r') && (string[1] == 'e')) 	/* rerun */
      {
      offset = CODE_START;
      CLEAR_LOCAL(MONIT.LEVEL);		/* clear local keyw.at curr. level */
      goto get_line;
      }
   else if (string[0] == 'q') 			/* quit */
      {
      MONIT.LEVEL = 1;			      /* return to interactive level */
      goto sect_3300;
      }
   else if ((string[0] == 'p') && (string[1] == 'a'))		/* pause  */
      {
      prcnt = offset1;		/* reset to begin of current command line */
      MONIT.PDEBUG[MONIT.LEVEL] = 77;	/* indicate `PAUSE' for next round */
      LINE.LEN = CGN_COPY(LINE.STR,"move/local out");	/* save local keys */
      (void) PARSE(2,0,0);				/* in this round */
      }
   else if (string[0] == 'p')			/* print keyword */
      {
      iwa = MID_DSPKEY(&string[2],'x',0L);
      if (iwa != ERR_NORMAL) (void) printf("invalid keyname...\n\r");
      goto debug_loop;
      }
   else if (string[0] == 's')			/* step `nostp' */
      {
      mm = 1;
      if (string[1] != '\0')
         {
         (void) CGN_CNVT(&string[2],1,1,&mm,&rwa,&dwa);
         if (mm < 1) mm = 1;
         }
      Mdbstep = mm;
      }
   else if (string[0] == 'l')			/* list */
      {
      mm = 20;					/* no. of lines to show */
      if (string[1] != '\0')
         {
         ibuf[0] = ibuf[1] = -1;
         (void) CGN_CNVT(&string[2],1,2,ibuf,&rwa,&dwa);
         if (ibuf[0] < 1) 
            ibuf[0] = Mdbindx;
         else if (ibuf[0] > Mdbcount) ibuf[0] = Mdbcount;
         if (ibuf[1] < ibuf[0]) ibuf[1] = ibuf[0] + mm - 1;
         mm = ibuf[1] - ibuf[0] + 1;

         if (ibuf[0] == Mdbindx)
            iwa = offset1;
         else
            {
            Mdbline = Mdbptr;			/* reset to begin of array */
            Mdbindx = 1;
            iwa = CODE_START;
            iwb = ibuf[0] - 1;

            if (iwb > 0)
               {
               for (nr=0; nr<iwb; nr++)
                  {
                  nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');
                  iwa += (nn + 1);
                  }
               Mdbindx = ibuf[0];
               }
            }
         }

      for (nr=0; nr<mm; nr++)
         {
         nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');
         if (nn > 0)
            {
            (void) sprintf(string,"%4.4d ",Mdbindx);
            (void) strncpy(&string[5],&CODE.CODE[iwa],nn);
            string[nn+5] = '\0';
            (void) printf("%s\n\r",string);
            Mdbindx++;
            iwa += (nn + 1);
            }
         else
            break;				/* end of procedure */
         }
      goto debug_loop;			
      }
   else if (string[0] == 'b')			/* breakpoint handling */
      {
      if (string[1] == 's')				/* bs(how)  */
         {
         for (nr=0; nr<5; nr++)
            {
            if (Mbreak[nr] != -1)
               {
               (void) printf("breakpoint at line %4.4d for level = %d\n\r",
                      Mbreaklabl[nr],Mbreak[nr]);
               }
            }
         }
      else if (string[1] == 'c')				/* bc(ancel) */
         {
         n = CGN_CNVT(&string[3],1,1,ibuf,&rwa,&dwa);
         if (n != 1)
            {
            if (string[3] == 'a')
               {
               for (nr=0; nr<5; nr++)
                   Mbreak[nr] = -1;
               }
             else
               (void) printf("invalid breakpoint...\n\r");
            }
         else
            {
            for (nr=0; nr<5; nr++)
               {
               if (Mbreaklabl[nr] == ibuf[0])
                  {
                  Mbreak[nr] = -1;
                  break;
                  }
               }
            }
         }
      else
         {
         n = CGN_CNVT(&string[2],1,1,ibuf,&rwa,&dwa);
         if (n != 1)
            (void) printf("invalid breakpoint...\n\r");
         else
            {
            for (nr=0; nr<5; nr++)
               {
               if (Mbreak[nr] == -1)
                  {
                  Mbreak[nr] = MONIT.LEVEL;
                  Mbreaklabl[nr] = ibuf[0];
                  break;
                  }
               }
            }
         }
      goto debug_loop;
      }
   else if ((string[0] == 'h') || (string[0] == '?'))
      {
      (void) printf("RETURN    - execute displayed command\n");
      (void) printf("s count   - step through (execute) `count' commands\n");
      (void) printf
("c         - continue until end of current procedure or next breakpoint\n");
      (void) 
      (void) printf("rerun     - restart procedure again\n");
      printf("quit      - stop debugging + return to interactive level\n");
      (void) printf
             ("l la,lb   - list the procedure from line `la' to `lb'\n");
      (void) printf
             ("b bp      - set breakpoint at line `bp' of current proc.\n");
      (void) printf("bs        - show current breakpoints \n");
      (void) printf("bc bp     - cancel breakpoint at line `bp' \n");
      (void) printf
("pause     - interrupt debugging + return to interactive level\n");
      (void) printf("            there you can execute any MIDAS command\n");
      (void) printf("            to resume debugging enter CONTINUE ...\n");
      (void) printf
("p keyname - print (display) contents of keyword 'keyname'\n");
      (void) printf("h (or ?)  - display this help\n");
      goto debug_loop;
      }
   }


	
/*  test, if special command, 
    i.e. label:, *IF, *JF, *INC, *JNC, *BR, *GO, *JO, *RE, *PA    */
 
 
test_line:
	
/*         label:            */
 
if (TOKEN[0].STR[TOKEN[0].LEN-1] == ':') goto get_line;		/* skip */
 

/*  only check for '*' as first char.  */

if (TOKEN[0].STR[0] != '*')
   {					/*  update program flags + bye, bye  */
   MONIT.PCODE[MONIT.LEVEL-1] = prcnt;		/* save Program Counter   */
   return;
   } 

firstch = TOKEN[0].STR[1];



/*         *INC                 */
 
if (firstch == 'I')
   {
  inc_section:
   if (TOKEN[0].STR[2] == 'N') 
      {
      ERRORS.INDEX = 1;
      KEY_PARSE(TOKEN[1].STR,keyname,k_type,&iwb,&iwa,&n,&n);
      if (k_type[0] != 'I') goto badinc;	/* has to be integer key */
 
      stat = SCKRDI(keyname,iwa,1,&iav,&ikey,&unit,&nullo);
      if (stat != 0) goto badinc;

      n = CGN_CNVT(TOKEN[2].STR,1,1,&lstep,&rwa,&dwa);
      ERRORS.INDEX = 2;
      if (n != 1) 
         {
         (void) memcpy(save,"        ",(size_t)9);	/* include the '\0' */
         KEY_PARSE(TOKEN[2].STR,save,k_type,&iwb,&mm,&n,&n);
         if (k_type[0] != 'I') goto badinc;        /* has to be integer key */

         stat = SCKRDI(save,mm,1,&iav,&lstep,&unit,&nullo);
         if (stat != 0) goto badinc;
         }

      n = CGN_CNVT(TOKEN[3].STR,1,1,&looplim,&rwa,&dwa);
      if (n != 1) 
         {
         ERRORS.INDEX = 3;
         (void) memcpy(save,"        ",(size_t)9);	/* include the '\0' */
         KEY_PARSE(TOKEN[3].STR,save,k_type,&iwb,&mm,&n,&n);
         if (k_type[0] != 'I') goto badinc;        /* has to be integer key */

         stat = SCKRDI(save,mm,1,&iav,&looplim,&unit,&nullo);
         if (stat != 0) goto badinc;
         }

      ikey += lstep;			/* in/decrement loop variable */
      if (lstep < 0)
         {
         if (ikey < looplim) goto get_line;
         }
      else
         {
         if (ikey > looplim) goto get_line;
         }

      stat = SCKWRI(keyname,&ikey,iwa,1,&unit);  /* only now update */
      if (firstch == 'J')
         {
         offset = ibuf[0];
         goto get_line;  
         }
      else
         {
         nn = 4;			/* emulate goto TOKEN[4].STR:  */
         offset = CODE_START+1;
         igoto = 1;			/* we start at the top  */
         goto sect_2800;		/* continue like normal goto command */
         }

badinc:
      (void) strcpy(LINE.STR,"DO ");	/* rebuild original DO command */
      (void) strcat(LINE.STR,TOKEN[1].STR);
      n = TOKEN[1].LEN+3;
      (void) strcpy(&LINE.STR[n]," = ");
      n += 3;
      (void) sprintf(save,"%d ",ikey);
      (void) strcpy(&LINE.STR[n],save);
      (void) strcat(LINE.STR,TOKEN[3].STR);
      n = (int) strlen(LINE.STR);
      LINE.STR[n++] = ' ';
      (void) strcpy(&LINE.STR[n],TOKEN[2].STR);
      ERRORS.SYS = 5;   
      goto badexec;
      }
 
	
/*        *IF                 */
 
   else 
      {
      mm = EVALU(1);	     /* evaluate logical expr. starting at TOKEN(2) */
      if (mm < 0)
         {
         ERRORS.SYS = 26;
         goto badexec;
         }
      else if (mm == 1)
         {
         if (TOKEN[4].STR[0] == '*')		/* IF a .xy. b *RE  */
            goto sect_3300;
         else
            {
            nn = 4;					/* .TRUE.   */
            igoto = 9;
            goto sect_2800;	      /* emulate a forward:  GOTO TOKEN[4]:  */
            }
         }
 
      goto get_line;		/* .FALSE. => get next command line  */
      }
   }
 
	
/*        *BR              */
 
if (firstch == 'B')
   {
   GETOP(TOKEN[1].STR,TOKEN[1].LEN,&ikey,&rkey,save,&dkey,
         k_type,82);			/* get branch variable/constant...  */
	
   if (k_type[0] == 'I')
      {						/* convert comparisons  */
      m = CGN_CNVT(TOKEN[2].STR,1,20,ibuf,&rwa,&dwa);
      if (m < 1)
         {
         ERRORS.SYS = 5;
         goto badexec;
         }
      else
         {
         for (nr=0; nr<m; nr++)
            {
            if (ikey == ibuf[nr])
               {
               mm = nr;
               goto sect_2500;
               }
            }
         }
      }
	
   else if (k_type[0] == 'C')
      {
      iwa = 0;
      CGN_UPSTR(save);
 
      for (nr=0; nr<20; nr++)
         {
         m = CGN_EXTRSS(TOKEN[2].STR,TOKEN[2].LEN,',',&iwa,string,40);
         if (m < 1) goto get_line;		/* no match, goto next line */
 
         CGN_UPSTR(string);
         if (strcmp(save,string) == 0)
            {
            mm = nr;
            goto sect_2500;
            }
         }
      }
 
   else
      {
      ERRORS.SYS = 17;			/* invalid type of branch variable */
      goto badexec;
      }

   goto get_line;			/* no match, goto next line  */

 
/*  match found, now branch   */
 
sect_2500:
   iwa = 0;
 
   for (nr=0; nr<=mm; nr++)	             /* extract corresponding label */
      {
      m = CGN_EXTRSS(TOKEN[3].STR,TOKEN[3].LEN,',',&iwa,string,40);
      if (m < 0) goto get_line;	
      }
   (void) strcpy(TOKEN[4].STR,string);
   TOKEN[4].LEN = m;
   nn = 4;
   igoto = 0;                                   /* first, try from here on  */
   goto sect_2800;				/* simulate a forward goto  */
   }
 
	
/*         *GO                */
 
if (firstch == 'G')
   {
   nn =  1;					/* TOKEN[1] holds label  */
   igoto = 0;                                   /* first try forward jump  */
  
sect_2800:
   label[0] = '\r';
   nr = TOKEN[nn].LEN;
   CGN_UPCOPY(&label[1],TOKEN[nn].STR,nr);
   label[++nr] = ':';
   label[++nr] = '\r';				/* build search string  */
   label[++nr] = '\0';				/* build search string  */
   offset --;				  /* label may come right now...*/
  
sect_2900:
   n = CGN_INDEXS(&CODE.CODE[offset],label);
   if (n >= 0) 				 	/* all o.k.  */
      {
      offset += (n + nr);
      goto get_line;				/*  get next line  ...  */
      }
 

   /* required label not found...  */

   if (igoto == 0)                              /* try backward jump  */
      {
      igoto = 1;
      offset = CODE_START;
      goto sect_2900;
      }

   if (igoto == 1)
      {
      n = nr - 1;
      if ( strncmp(&CODE.CODE[offset],&label[1],n) == 0 )
         {		             /* at beginning of code (no leading \r) */
         offset += n;			/* offset was set to CODE_START */
         goto get_line;
         }
      }

   /*  no. We really have no chance...  */

   (void) strcpy(LINE.STR,"GOTO ");
   (void) strcat(LINE.STR,TOKEN[nn].STR);
   ERRORS.INDEX = nn;
   ERRORS.SYS = 21;
   goto badexec;
   }
 
	
/*         *JF, *JNC, *JO                */
 
if (firstch == 'J')
   {				
   cc = TOKEN[0].STR[2];
   if (cc == 'O')				/* GO offset */
      nn = 1;
   else
      nn = 4;					/* *IF / *INC . . . offset */
					/* get new offset in CODE.CODE */
   n = CGN_CNVT(TOKEN[nn].STR,1,1,ibuf,&rwa,&dwa);
   if (n != 1)
      {
      ERRORS.INDEX = nn;
      ERRORS.SYS = 21;
      goto badexec;
      }
   
   if (cc == 'O')			/* GO ... */
      {
      offset = ibuf[0];
      goto get_line;  
      }

   else if (cc == 'F')			/* IF ... */
      {
      mm = EVALU(1);         /* same stuff as in *IF section above */
      if (mm < 0)
         {
         ERRORS.SYS = 26;
         goto badexec;
         }
      else if (mm == 1)
         {
         if (TOKEN[4].STR[0] == '*')            /* IF a .xy. b *RE  */
            goto sect_3300;
         else
            offset = ibuf[0];
         }
      goto get_line;            /* .FALSE. => get next command line  */
      }

   else					/* *INC ... */
      goto inc_section;
   }


	
/*       *RE          */
 
if (firstch == 'R') 	                    /* RETURN q1 q2 q3 */
   {
   if (TOKEN[0].STR[2] == 'X')
      MONIT.LEVEL = 1;		 /* RETURN/EXIT terminates everything... !  */
   else
      {	      						/* for Q1, Q2, Q3   */
      for (nr=0; nr<3; nr++)
         {
         nn = MONIT.POFF[8+nr];
         (void) memcpy(&KCWORDS[nn],TOKEN[nr+1].STR,(size_t)60);
         }
      }
   goto sect_3300;		     /* terminate this level (at least...)  */
   }
 

/*        *PA         */
 
if (firstch == 'P')
   {
   if (MONIT.PAUSLEVL >= 0)		/* avoid nested PAUSE commands */
      {
      if (TOKEN[0].STR[2] == 'D')          /*  here from Mdb */
         (void) printf("Old PAUSEd procedure code is overwritten...\n");
      else
         {
         (void) strcpy(LINE.STR,"PAUSE ");
         ERRORS.INDEX = -1;
         ERRORS.SYS = 110;
         goto badexec;
         }
      }

   MONIT.PCODE[MONIT.LEVEL-1] = prcnt;			/* save the PC  */
   for (nr=0; nr<MAX_LEVEL; nr++)
      {
      MONIT.QDEBUG[nr+1] = MONIT.PDEBUG[nr+1];
      MONIT.QCODE[nr] = MONIT.PCODE[nr];
      TRANSLATE[nr].LEN[1] = TRANSLATE[nr].LEN[0];
      TRANSLATE[nr].LEN[0] = 0;		/* we should not free that memory... */
      TRANSLATE[nr].PNTR[1] = TRANSLATE[nr].PNTR[0];
      }

   (void) strcpy(PROC.QNAME,PROC.FNAME);   /* save name of interrupted proc. */
   MONIT.PAUSLEVL = MONIT.LEVEL;
   MONIT.INTERRUPT = 1;

   if (TOKEN[0].STR[2] == 'D')		/*  here from Mdb */
      {
      for (nr=1; nr<MAX_LEV1; nr++)	/* to avoid nr<=MAX_LEVEL ... */
         MONIT.PDEBUG[nr] = 0;		/* no debugging initially */
      }

   MONIT.LEVEL = 1;				/*  like RETURN/EXIT  */
   goto sect_3300;
   }
	
ERRORS.SYS = 5;			  /* all that remains is "wrong syntax" ...*/
 
 
/*  problems during compilation and execution    */
 
badexec:
if (perror == 1) 
   {
   if (ERRORS.INDEX == -1)
      PREPERR("MIDAS",LINE.STR," ");
   else
      PREPERR("MIDAS",LINE.STR,TOKEN[ERRORS.INDEX].STR);
   }
(void) sprintf(string,"In Midas procedure: %s",PROC.FNAME);
SCTPUT(string);
 
MONIT.LEVEL = 1;		/* force return to interactive level */


/*

*/
  
/*  ...........................................................  */
	
	
/*             end of program - backup to higher level           */
	
/*  ...........................................................  */
 
	
sect_3300:
CLEAR_LOCAL(MONIT.LEVEL);			/* clear any local keys...  */

 
/*  if, next higher level still > 0, get back corresponding code   */
 
if (MONIT.LEVEL <= 1)
   {
   MONIT.TOPLEVL = 0;
   MONIT.LEVEL = 0 ;		
   KIWORDS[OFF_MODE+6] = 0;
   KIWORDS[OFF_LOG+3] = 0;		/* make sure to enable display */
   fixout(0,0);
   (void) MID_CCLO(-1);	
   if (MONIT.FRAME_USED != ' ')		/* close all open images/tables */
      FRAMACC('X',KAUX.OUT,0,&iav);
   return;				/* in interactive mode */
   }
 

if (MONIT.TOPLEVL < MONIT.LEVEL)	/* follow highest level */
   MONIT.TOPLEVL = MONIT.LEVEL;

KIWORDS[OFF_MODE+6] = -- MONIT.LEVEL;	/* decrement procedure level */
nn = MONIT.LEVEL - 1;
CODE.CODE = TRANSLATE[nn].PNTR[0];
CODE.LEN = TRANSLATE[nn].LEN[0];
fixout(0,MONIT.LEVEL);			/* try to close output file */
(void) MID_CCLO(-1);			/* close all catalogs */
 
/*  do not forget to reset the parameter keys also...   */
 
SAVE_PARM(2,MONIT.LEVEL,&n);	
goto execute;	       /* fetch next instruction from higher level procedure */
}