/* @(#)prg2code.c	19.1 (ESO-DMD) 02/25/03 13:58:46 */
/*===========================================================================
  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 utility routines PRG2CODE  +++++++++++++++++++
.LANGUAGE  C
.IDENTIFICATION Module PRG2CODE
.AUTHOR         K. Banse                  ESO - Garching
.KEYWORDS
  MIDAS procedures, parsing, code generation
.VERSION
 [1.00] 020711		creation
.ALGORITHM
 we translate as much as possible to FORTRAN code
 this program is written for Unix/Linux/Mac OSX only

 if needed, with our `ftoc' we can convert the resulting Fortran
 module to C

 021129         last modif

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

#include <fileexts.h>

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

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

int    is_a_tty = 1;                        /* Is this a terminal, (yes=1) */

char  midas_root[100];

#define PRG2_MAXVAR  100		/* max. 100 vars */

void intermail()

{
return;
}


/*

*/


int main(argc,argv)
int argc;
char *argv[];


{
int   pxinfo[6];
int   parno, inco, outco;
int   n, defset, nbra, stat, start, jk, jj;

char    wbuf[2*MAX_TOKEN];
char    wstr[100], versio[16];
char   *argptr, cxp[4];




/* set up `midas_root' to $MIDASHOME/$MIDVERS/ */

stat = OSY_TRNLOG("MIDASHOME",wstr,100,&jj);	/* get Midas home dir */
if (stat != 0) jj = CGN_COPY(wstr,"/midas");
if (wstr[jj-1] != FSY_DIREND) wstr[jj++] = FSY_DIREND;

stat = OSY_TRNLOG("MIDVERS",versio,160,&jj);
if (stat != 0) jj = CGN_COPY(versio,"test");

(void) strcpy(midas_root,wstr);
(void) strcat(midas_root,versio);
(void) strcat(midas_root,"/");

qinit_here();		/* initialize */

ERRORS.OFFSET = FRONT.PEND + 5;

pxinfo[0] = 80;
pxinfo[1] = 24;
for (jj=0; jj<4; jj++) cxp[jj] = 'N';
(void) prepx(-1,cxp,pxinfo);

stat = do_the_job(argv[1]);

}

/*

*/
 
void qinit_here()

{
int  stat, jj;

char   wstr[160];




FRONT.DAZUNIT[0] = '6';			/* use unit 66 */
FRONT.DAZUNIT[1] = '6';

stat = OSY_TRNLOG("MID_WORK",wstr,160,&jj);    /* Decode startup directory */
if (stat != 0) 
   {
   stat = OSY_TRNLOG("HOME",wstr,160,&jj);	/* use $HOME/midwork/ */
   if (wstr[jj-1] != FSY_DIREND) wstr[jj++] = FSY_DIREND;
   (void) strcpy(&wstr[jj],"midwork/");
   }
else if (wstr[jj-1] != FSY_DIREND)
   {
   wstr[jj++] = FSY_DIREND;
   wstr[jj] = '\0';
   }

(void) strcpy(FRONT.STARTUP,wstr);	/* save name of startup directory */

FRONT.ENV = '*';		/* to indicate Unix command line input */
FRONT.PEND = 6;			/* length of prompt + 1 */
FRONT.PID = 0;			/* not used */
FRONT.PP = -1;
FRONT.PLAYBACK = 0;
FRONT.INTERM = 0;

server.MODE = 0;
server.ECHO = 'N';
}

/*

*/

int do_the_job(infile)
char  *infile;

{
int   kk, nn, iwa, pxinfo[6];
int   parno, lstart, inco, outco;
int   n, mm, defset, nbra, stat, start, jk, jj;
int   noelem, unit;
int   fp, gp, tp;
int   varcount;

register int  nr;
long int since;

char    wbuf[2*MAX_TOKEN];
char    varia[24],  *cpntra, work[240];
char    save[82], type[16], command[8], qualif[8], defqual[8];
char    varbuf[PRG2_MAXVAR*24];






varcount = 0;

/* very first scan of input procedure:
   get rid of all continuation lines */

fp = CGN_OPEN(infile,0);
if (fp < 0)
   {
   (void) printf("Could not open %s ...\n",infile);
   return(-1);
   }

gp = CGN_OPEN("klauss.prg",1);		/* write to this file */
if (gp < 0)
   {
   (void) printf("Could not create `klauss.prg'...\n");
   return(-1);
   }


read0_loop:
LINE.LEN = osaread(fp,LINE.STR,100);
if (LINE.LEN == 0)
   goto read0_loop;
else if (LINE.LEN == -1)		/* EOF */
   {
   (void) osaclose(fp);
   (void) osaclose(gp);
   goto step_0;
   }

CGN_UPCOPY(work,LINE.STR,8);
work[5] = '\0';
if (strcmp(work,"ENTRY") == 0)
   {
   (void) printf("%s has to be converted separately...\n",LINE.STR);
      (void) osaclose(fp);
   (void) osaclose(gp);
   goto step_0;
   }

while (LINE.STR[LINE.LEN-1] == '-')	/* continuation line?*/
   {
   LINE.STR[LINE.LEN-1] = ' ';
   nn =  osaread(fp,work,100);
   (void) strcat(LINE.STR,work);
   LINE.LEN = (int) strlen(LINE.STR);
   }

(void) osawrite(gp,LINE.STR,LINE.LEN);
goto read0_loop;


/* very first scan of input procedure:
   replace 	IF ... command 		(without THEN in the end)
   with		IF ... THEN
      		   command
   		ENDIF	

   also get already rid of comments 	*/


step_0:
fp = CGN_OPEN("klauss.prg",0);
if (fp < 0)
   {
   (void) printf("Could not open `klauss.prg'...\n");
   return(-1);
   }

gp = CGN_OPEN("klaus.prg",1);		/* write to this file */
if (gp < 0)
   {
   (void) printf("Could not create `klaus.prg'...\n");
   return(-1);
   }


read1_loop:
LINE.LEN = osaread(fp,LINE.STR,200);
if (LINE.LEN == -1)			/* EOF */
   {
   (void) osaclose(fp);
   (void) osaclose(gp);
   goto scan_1;
   }


MONIT.COUNT = 0 ;                       /* init MONIT.COUNT */
for (nr=0; nr<LINE.LEN; nr++)
   {						/* cut off comments */
   if ((LINE.STR[nr] != ' ') && (LINE.STR[nr] != '\t'))
      {	
      if (LINE.STR[nr] == '!') goto read1_loop;

      lstart = nr;
      goto step_1;
      }
   }
return (-9);                          /* nothing there */


/*  extract all tokens + get their length */

step_1:
for (nr=lstart; nr<LINE.LEN; nr++)
   {
   if (LINE.STR[nr] == '\t') LINE.STR[nr] = ' ';

   if (LINE.STR[nr] == '!')
      {
      iwa = nr - 1;
      if (LINE.STR[iwa] == ' ') 
         {
         LINE.STR[iwa] = '\0';
         LINE.LEN = iwa;
         goto parse_1;
         }
      }
   }

parse_1:
jk = Parse2(0,lstart);
if (jk < 0)
   {
   printf("input not o.k.\n");
   goto read1_loop;
   }
else
   MONIT.COUNT = jk;

CGN_UPSTR(TOKEN[0].STR);
if (strcmp(TOKEN[0].STR,"IF") == 0)
   {
   nn = MONIT.COUNT - 1;		/* last TOKEN */
   kk = CGN_UPCOPY(work,TOKEN[nn].STR,8);
   if (strcmp(work,"THEN") != 0)
      {				/* IF ... command (no closing THEN) */
      memset((void *)work,32,(size_t)40);
      (void) strcpy(&work[lstart],"IF ");
      (void) strcat(work,TOKEN[1].STR);
      (void) strcat(work," ");
      (void) strcat(work,TOKEN[2].STR);
      (void) strcat(work," ");
      (void) strcat(work,TOKEN[3].STR);
      (void) strcat(work," THEN");
      nn = (int) strlen(work);
      (void) osawrite(gp,work,nn);
      memset((void *)work,32,(size_t)40);
      (void) strcpy(&work[lstart+3],TOKEN[4].STR);
      for (nr=5; nr<MONIT.COUNT; nr++)
         {
         (void) strcat(work," ");
         (void) strcat(work,TOKEN[nr].STR);
         }
      
      nn = (int) strlen(work);
      (void) osawrite(gp,work,nn);
      memset((void *)LINE.STR,32,(size_t)40);
      (void) strcpy(&LINE.STR[lstart],"ENDIF");
      LINE.LEN = (int) strlen(LINE.STR);
      }
   }
(void) osawrite(gp,LINE.STR,LINE.LEN);
goto read1_loop;


scan_1:
fp = CGN_OPEN("klaus.prg",0);
if (fp < 0)
   {
   (void) printf("Could not open klaus.prg ...\n");
   return(-1);
   }
inco = 0;

gp = CGN_OPEN("klaus_1.for",1);		/* write to this file */
if (gp < 0)
   {
   (void) printf("Could not create `klaus_1.for'...\n");
   return(-1);
   }
outco = 0;


read_loop:
LINE.LEN = osaread(fp,LINE.STR,200);
if (LINE.LEN == -1)
   {
   (void) osaclose(fp);
   printf("%d input lines processed\n",inco);
   goto close_code;
   }

inco ++;
/*
(void) printf("in-%d: %s\n",inco,LINE.STR);
*/


/*  initialize + check LINE.LEN   */

MONIT.COUNT = 0 ;                       /* init MONIT.COUNT */
for (nr=0; nr<LINE.LEN; nr++)
   {
   if (LINE.STR[nr] != ' ')
      {
      lstart = nr;
      goto step_2;
      }
   }



/*  extract all tokens + get their length */

step_2:
MONIT.COUNT = Parse2(0,lstart);

EXTRACOM(TOKEN[0].STR,command,qualif);
stat = FINDCOM(command,qualif,defqual,&defset,&nbra,&cpntra,&kk);

outco++;
memset((void *)work,32,(size_t)100);

if (TOKEN[0].STR[TOKEN[0].LEN-1] == ':')	/* is it a label? */
   goto just_copy;

jk = 0;
for (nr=1; nr<MONIT.COUNT; nr++)
   {
   if (TOKEN[nr].STR[1] == '$')
      {
      if ((TOKEN[nr].STR[0] == 'M') || (TOKEN[nr].STR[0] == 'm'))
         {
         kk = CGN_INDEXC(TOKEN[nr].STR,'(');
         TOKEN[nr].STR[kk] = '\0';
         CGN_UPSTR(TOKEN[nr].STR);
         TOKEN[nr].STR[kk] = '(';
         jk = 1;
         }
      }
   }
if (jk == 1)				/* yes we changed */
   {
   memset((void *)LINE.STR,32,(size_t)20);
   (void) strcpy(&LINE.STR[lstart],TOKEN[0].STR);	/* rebuild LINE.STR */
   for (nr=1; nr<MONIT.COUNT; nr++)
      {
      (void) strcat(LINE.STR," ");
      (void) strcat(LINE.STR,TOKEN[nr].STR);
      }
   }


CGN_UPSTR(TOKEN[0].STR);

if (strcmp(TOKEN[0].STR,"CROSSREF") == 0) goto read_loop;

if (strcmp(TOKEN[0].STR,"GOTO") == 0) 
   goto write_file;

if (strncmp(TOKEN[0].STR,"RETURN",6) == 0) 
   {
   kk = CGN_INDEXS(TOKEN[0].STR,"/E");
   if (kk > 0)
      (void) strcpy(&work[6+lstart],"RETURN 99");
   else
      (void) strcpy(&work[6+lstart],"RETURN");
   goto write_file;
   }

if (strcmp(TOKEN[0].STR,"IF") == 0) 
   {
   kk = 0;
   (void) strcpy(&work[6+lstart],"IF (");
   goto handle_IF;
   }

if (strncmp(TOKEN[0].STR,"ELSE",4) == 0) 
   {
   kk = -1;
   if (TOKEN[0].STR[4] == 'I')
      kk = 0;
   else if (strcmp(TOKEN[4].STR,"IF") == 0) 
      kk = 1;
   if (kk < 0)
      {
      (void) strcpy(&work[6+lstart],"ELSE ");
      goto write_file;
      }
   else
      {
      (void) strcpy(&work[6+lstart],"ELSE IF ( ");
      goto write_file;
      }
   }

if ( (strncmp(TOKEN[0].STR,"END",3) == 0) ||
     (strncmp(TOKEN[0].STR,"RETURN",6) == 0) ||
     (strcmp(TOKEN[0].STR,"DO") == 0) )
   {
   (void) strcpy(&work[6],LINE.STR);
   CGN_UPSTR(work);
   goto write_file;
   }

if (strcmp(TOKEN[1].STR,"=") == 0)		/* direct command */
   {
   (void) strcpy(work,"      ");
   (void) strcat(work,LINE.STR);
   goto write_file;
   }

if (TOKEN[0].STR[0] == '-')
   {
   (void) strcpy(work,"os_com ");
   (void) strcat(work,&LINE.STR[lstart+1]);
   goto write_file;
   }

if (TOKEN[0].STR[0] == '$')
   {
   (void) strcpy(work,"os_com ");
   (void) strcat(work,&LINE.STR[lstart]);
   goto write_file;
   }


if (nbra >= 0) 
   {
   if ((kk > 0) && (cpntra != (char *) 0))
      {
      (void) strncpy(LINE.STR,cpntra,kk);	/* fill command LINE.STR */
      LINE.STR[kk] = '\0';
      for (nr=1; nr<MONIT.COUNT; nr++)
         {
         (void) strcat(LINE.STR," ");
         (void) strcat(LINE.STR,TOKEN[nr].STR);
         }
      }
   goto just_copy; 
   }


nbra = -nbra;

/*
printf("nbra = %d\n",nbra);
*/


/* process some of the commands */

if (nbra == 18) 
   {					/* ignore DEFINE/MAXPAR */
   outco --;
   goto read_loop;
   }

else if ((nbra == 2) || (nbra == 17))
   {			      /* DEFINE/LOCAL_KEY  key/type/first/noval */
   jk = CGN_INDEXC(TOKEN[1].STR,'/');
   memset((void *)work,32,(size_t)100);
   if (jk < 1)
      {
      (void) strcpy(varia,TOKEN[1].STR);
      (void) strcpy(save,"ojo");
      }
   else
      {
      (void) strncpy(varia,TOKEN[1].STR,jk);
      varia[jk] = '\0';
      start = jk + 1;
      jk = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,type,15);

      jk = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,save,10);
      jk = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,save,10);
      }

   kk = 0;
   for (nr=0; nr<varcount; nr++)		/* compare with the others */
      {
      if (strcmp(varia,&varbuf[kk]) == 0) goto fill_data;
      kk += 24;
      }
   if (varcount < PRG2_MAXVAR)		/* add variable to buffer */
      {
      kk = varcount * 24;
      (void) strcpy(&varbuf[kk],varia);
      varcount ++;
      }
   else
      {
      (void) printf("no. of variables = %d, exceeds limit of %d\n",
             (varcount+1),PRG2_MAXVAR);
      return (99);
      }
   if ((int)strlen(varia) == 2)		/* look for P1 ... P8 */
      {
      if ((varia[0] == 'P') || (varia[0] == 'p'))
         {
         if (CGN_INDEXC("12345678",varia[1]) > -1) goto fill_data;
         }
      }

   if ((type[0] == 'i') || (type[0] == 'I'))
      (void) strcpy(work,"defineINTEGER ");
   else if ((type[0] == 'r') || (type[0] == 'R'))
      (void) strcpy(work,"defineREAL ");
   else if ((type[0] == 'd') || (type[0] == 'D'))
      (void) strcpy(work,"defineDOUBLE PRECISION  ");
   else 
      {
      type[0] = 'C';
      (void) strcpy(work,"defineCHARACTER ");
      }
   (void) strcat(work,varia);
   if (type[0] != 'C')
      (void) strcat(work,"(");
   else
      (void) strcat(work,"*");

   (void) strcat(work,save);
   if (type[0] != 'C') (void) strcat(work,")");
   nn = (int) strlen(work);
   (void) osawrite(gp,work,nn);
   printf("%d: %s\n",outco,work);

   /* for now also fill the data */
   
   fill_data:
   memset((void *)work,32,(size_t)100);
   (void) strcpy(&work[6+lstart],varia);
   (void) strcat(work," = ");
   (void) strcat(work,TOKEN[2].STR);
   if (TOKEN[3].STR[0] != '?')
      {
      (void) strcat(work," ");
      (void) strcat(work,TOKEN[3].STR);
      }
   goto write_file;
   }

else if (nbra == 19)
   {					/* DEFINE/PARAM */
   (void) strcpy(&work[6+lstart],"CALL STKRDC('");
   (void) strcat(work,TOKEN[1].STR);
   (void) strcat(work,"',1,1,80,IAV,");
   (void) strcat(work,TOKEN[1].STR);
   (void) strcat(work,",UNI,NULO,STAT)");
   nn = (int) strlen(work);
   (void) osawrite(gp,work,nn);
   printf("%d: %s\n",outco++,work);
   (void) strcpy(work,"! ");
   (void) strcat(work,&LINE.STR[lstart]);
   goto write_file;
   }

else if (nbra == 44)
   {					/* RUN */
   (void) strcpy(work,"run ");
   (void) strcat(work,TOKEN[1].STR);
   goto write_file;
   }

else if (nbra == 66)
   {					/* WRITE/OUT */
   (void) strcpy(&work[6+lstart],"CALL STTPUT('");
   if (TOKEN[1].STR[0] == '"')
      kk = 1;
   else
      kk = 0;
   (void) strcat(work,&TOKEN[1].STR[kk]);
   for (nr=2; nr<MONIT.COUNT; nr++)
      {
      (void) strcat(work," ");
      (void) strcat(work,TOKEN[nr].STR);
      }
   nn = (int) strlen(work) - kk;
   (void) strcpy(&work[nn],"')");
   goto write_file;
   }

else if (nbra == 68)
   {					/* WRITE/ERROR */
   (void) strcpy(&work[6+lstart],"CALL STETER(");
   (void) strcat(work,TOKEN[1].STR);
   (void) strcat(work,",'");
   if (TOKEN[2].STR[0] == '"')
      kk = 1;
   else
      kk = 0;
   (void) strcat(work,&TOKEN[2].STR[kk]);
   nn = (int) strlen(work) - kk;
   (void) strcpy(&work[nn],"')");
   goto write_file;
   }

else if (nbra == 69)
   {					/* OPEN/FILE */
   (void) strcpy(&work[6+lstart],"CALL OSAOPEN('");
   (void) strcat(work,TOKEN[1].STR);
   if (TOKEN[2].STR[0] == 'R')
      (void) strcat(work,"',0,");
   else
      (void) strcat(work,"',1,");
   (void) strcat(work,TOKEN[3].STR);
   (void) strcat(work,")");
   goto write_file;
   }

else if (nbra == 70)
   {					/* CLOSE/FILE */
   (void) strcpy(&work[6+lstart],"CALL OSACLOSE(");
   (void) strcat(work,TOKEN[1].STR);
   (void) strcat(work,")");
   goto write_file;
   }

else if (nbra == 71)
   {					/* WRITE/FILE */
   (void) strcpy(&work[6+lstart],"CALL OSAWRITE(");
   (void) strcat(work,TOKEN[1].STR);
   for (nr=2; nr<MONIT.COUNT; nr++)
      {
      (void) strcat(work,",");
      (void) strcat(work,TOKEN[nr].STR);
      }
   (void) strcat(work,")");
   goto write_file;
   }

else if (nbra == 72)
   {					/* READ/FILE */
   (void) strcpy(&work[6+lstart],"CALL OSAREAD(");
   (void) strcat(work,TOKEN[1].STR);
   (void) strcat(work,",");
   (void) strcat(work,TOKEN[2].STR);
   (void) strcat(work,")");
   goto write_file;
   }



just_copy:
(void) strcpy(&work[6],LINE.STR);
goto write_file;



handle_IF:
(void) strcat(work,TOKEN[1+kk].STR);
(void) strcat(work," ");
CGN_UPSTR(TOKEN[2+kk].STR);
(void) strcat(work,TOKEN[2+kk].STR);
(void) strcat(work," ");
(void) strcat(work,TOKEN[3+kk].STR);
(void) strcat(work,") ");
CGN_UPSTR(TOKEN[4+kk].STR);
(void) strcat(work,TOKEN[4+kk].STR);
for (nr=5+kk; nr<MONIT.COUNT; nr++)
   {
   (void) strcat(work,TOKEN[nr].STR);
   (void) strcat(work," ");
   }
goto write_file;


write_file:
nn = (int) strlen(work);

write_out:
(void) osawrite(gp,work,nn);
printf("%d: %s\n",outco,work);
goto read_loop;


close_code:
osaclose(fp);
osaclose(gp);


/* now scan the intermediate file again to put LINE.STR into
   the right order (for FORTRAN) */

fp = CGN_OPEN("klaus_1.for",0);
if (fp < 0)
   {
   (void) printf("Could not open klaus_1.for'...\n");
   return(-1);
   }


gp = CGN_OPEN("klaus_2.for",1);         /* write to this file */
if (gp < 0)
   {
   (void) printf("Could not create `klaus_2.for'...\n");
   return(-1);
   }
outco = 0;


tp = CGN_OPEN("template.for",0);
if (tp < 0)
   {
   (void) printf("Could not open `template.for' ...\n");
   return(-1);
   }

while (1)
   {
   LINE.LEN = osaread(tp,LINE.STR,200);
   if (strncmp(LINE.STR,"C--1",4) == 0) break;

   (void) osawrite(gp,LINE.STR,LINE.LEN);
   }

while ((LINE.LEN = osaread(fp,LINE.STR,200)) > -1)
   {
   if (LINE.LEN > 0)
      {
      if (strncmp(LINE.STR,"define",6) == 0)
         {
         for (nr=0; nr<6; nr++) LINE.STR[nr] = ' ';
         kk = CGN_INDEXC(LINE.STR,'(');		/* abc(1) => abc */
         (void) strcpy(work,&LINE.STR[kk+1]);
         nn = (int) strlen(work);
         work[nn-1] = '\0';
         iwa = atoi(work);
         if (iwa == 1) LINE.STR[kk] = '\0';
         (void) osawrite(gp,LINE.STR,(int)strlen(LINE.STR));
         }
      }
   }
osaclose(fp);

while (1)
   {
   LINE.LEN = osaread(tp,LINE.STR,200);
   if (strncmp(LINE.STR,"C--3",4) == 0) break;

   (void) osawrite(gp,LINE.STR,LINE.LEN);
   }

fp = CGN_OPEN("klaus_1.for",0);
while ((LINE.LEN = osaread(fp,LINE.STR,200)) > -1)
   {
   if (LINE.LEN > 0)
      {
      if (strncmp(LINE.STR,"define",6) != 0)
         (void) osawrite(gp,LINE.STR,LINE.LEN);
      }
   }

osaclose(fp);

while (1)
   {
   LINE.LEN = osaread(tp,LINE.STR,200);
   if (strncmp(LINE.STR,"C--4",4) == 0) break;

   (void) osawrite(gp,LINE.STR,LINE.LEN);
   }

osaclose(tp);
osaclose(gp);


return 0;
}