/* @(#)internal1.c	17.1.1.1 (ES0-DMD) 01/25/02 17:37:34 */
/*===========================================================================
  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
===========================================================================*/

/* +++++++++++++++++++++++++   INTERNAL1.C   ++++++++++++++++++++++++++++++++++
	
K. Banse	version 3.30	850821
	
create + initialize file MID_PROC:internal.kod
or display file MID_PROC:internal.cod
	
The file MID_PROC:internal.cod (or .kod) is organized as follows:
first 4 records (of 512 bytes) hold the procedure names of max. 12 chars 
(without the terminating '\0'),
the end of this area is indicated via '&&' .
Records 5+6 hold the array of start blocks and no. of bytes for each compiled 
procedure stored as two unsigned short int numbers,
the end of this area is indicated via a start block of 0.
The following records hold the translated code for each procedure, each
beginning at a record.
The end of the written records is indicated by a record beginning
with 20 blanks.
	
 010424		last modif

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

#include <fileexts.h>

#include <osyparms.h>
#include <osparms.h>
#include <fsydef.h>

#define BIT_0  0x1
#define FILE_MASK 0     /* CG. 920529: Set to 0. osfcreate() makes default */

#define PROC_MXLEN  12

/*

*/

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

{
static int block_lim=400;

int  nvb, iav, iostat;
int  chanl, indx;
int  total, ll, m, n, nn, stat;
int   fpi, fpo;
unsigned short int  *rec_nos;
register int nr, mr;

char record[3072], action[22];
char cbuf[512], line[80], file[200];
char procs[2048], procedure[PROC_MXLEN];
char *cptr, blank_str[20];



CGN_FILL(blank_str,' ',20);

if (argc > 1)
   {
   if (*argv[1] == '?')
      {
      (void)printf("provide option on command line:\n");
      (void) printf("INIT for init,\n");
      (void)printf("Rxy for read (x=C or K, y= A or ' ')\n");
      goto end_of_it;
      }
   else
      (void) strcpy(action,argv[1]);
   }
else
   (void) strcpy(action,"rc ");
CGN_UPSTR(action);

(void) OSY_TRNLOG("MID_PROC",file,200,&m);
#if vms
if (file[m-1] != FSY_DISKEND)
   {
   if (file[m-1] != FSY_DIREND) file[m++] = FSY_DIREND;
   }
#else
if (file[m-1] != FSY_DIREND) file[m++] = FSY_DIREND;
#endif
(void) strcpy(&file[m],"internal.cod");


rec_nos = (unsigned short int *) &record[2048];   /* here begin the rec_nos */

if (action[0] == 'I') goto sect_5000;


/* default action is:  display file internal.cod or internal.kod  */

m = (int) strlen(file);

if (action[1] == 'K') file[m-3] = 'k';

FSY_OPNFIL(file,m,&chanl,&iostat);
if ( !(iostat & BIT_0) ) goto sect_9100;


/* first show procedure_names */

stat = OSY_RVB(chanl,record,3072,1); 		/* get first 6 records */
if (stat != 0) goto sect_9200;

indx = 0;
nn = 1;
total = 0;

while(nn>0)					/* i.e. forever */
   {
   (void)printf("%72.72s\n",&record[indx]);	/* 6 names per line */
   for (m=indx; m<indx+72; m+=PROC_MXLEN)
      {
      if ( (record[m] == '&') && (record[m+1] == '&') )
         goto sect_2000;
      total ++;
      }
   indx += 72; 
   }
sect_2000:
(void) printf("%d translated procedures stored\n",total);


/*  now show the start blocks and lengths  */

for (nr=0; nr<512; nr+=10)
   {
   for (mr=nr; mr<nr+10; mr+=2)
      {
      if (rec_nos[mr] == 0)
         {
         (void)printf("\n");
         goto sect_2010;
         }

      (void)printf("%4.4d %5.5d   ",rec_nos[mr],rec_nos[mr+1]);
      }
   (void)printf("\n");
   }


/* check, if READ,ALL option (or just READ)   */

sect_2010:
if (CGN_INDEXC(action,'A') > 0)
   {
   char  reco[8000];

   for (nr=0; nr<total; nr++)
      {
      (void) printf("-------------------------------------------------\n");
      m = nr * 2;
      n = rec_nos[m];
      nn = rec_nos[m+1];
      if (nn > 7999)  nn = 7999;

      stat = OSY_RVB(chanl,reco,nn,n);
      if (stat != 0) goto sect_9200;

      indx = 0;
      for (mr=0; mr<nn; mr++)                   /* replace line terminators */
         {
         if (reco[mr] == '\r')
            {
            reco[mr] = '\0';
            ll = (int) strlen(&reco[indx]);
            if (ll > 0)
               {
               (void) printf("%s\n",&reco[indx]);
               indx += ll;
               }
            indx ++;
            }
         else if (reco[mr] == '\0')
            reco[mr] = ' ';
         }
      }
   }
goto end_of_it;


/*  create new file internal.kod (!)   */

sect_5000:
m = (int) strlen(file);
file[m-3] = 'k';
iav = m;


#if vms

FSY_CREBDF(file,m,block_lim,&nvb,&iostat);

#else

n = block_lim * BLOCK_SIZE;
nn = osfcreate(file, n, FILE_MASK);
if (nn != -1)
   {
   nvb = nn / BLOCK_SIZE;
   iostat = 1;
   }
else
   iostat = 0;

#endif


if ( !(iostat & BIT_0) ) goto sect_9100;
 
FSY_OPNFIL(file,iav,&chanl,&iostat);
if ( !(iostat & BIT_0) ) goto sect_9100;


/* write "clean" header records  */

CGN_FILL(record,' ',2048);
record[0] = '&';
record[1] = '&';

for (nr=0; nr<512; nr++) rec_nos[nr] = 0;
rec_nos[0] = 7;			/* point to first free record  */

stat = OSY_WVB(chanl,record,3072,1);
if (stat != 0) goto sect_9300;


/* now clear all the remaining records  */

record[0] = ' ';
record[1] = ' ';
for (nr=7; nr<block_lim; nr++)
   {
   stat = OSY_WVB(chanl,record,512,nr);
   if (stat != 0) goto sect_9300;
   }


/* finally prepare input file for MIDAS commands TRANSLATE/ADD  */


(void) OSY_TRNLOG("MID_PROC",file,200,&m);
#if vms
if (file[m-1] != FSY_DISKEND)
   {
   if (file[m-1] != FSY_DIREND) file[m++] = FSY_DIREND;
   }
#else
if (file[m-1] != FSY_DIREND) file[m++] = FSY_DIREND;
#endif
(void) strcpy(&file[m],"init.cod");


fpo = osaopen(file,1);                        /*  open for writing  */
if (fpo == -1) goto sect_9400;


(void) OSY_TRNLOG("MID_MONIT",file,200,&m);
#if vms
if (file[m-1] != FSY_DISKEND)
   {
   if (file[m-1] != FSY_DIREND) file[m++] = FSY_DIREND;
   }
#else
if (file[m-1] != FSY_DIREND) file[m++] = FSY_DIREND;
#endif
(void) strcpy(&file[m],"newcom.in");


fpi = osaopen(file,0);                        /*  open for reading  */
if (fpi == -1) goto sect_9500;

CGN_FILL(procs,' ',2048);
indx = -1;

read_loop:
CGN_FILL(line,' ',80);
stat = osaread(fpi,line,72);
if ((stat == 0) || (line[0] == '!'))	/* avoid empty + comment lines */
   goto read_loop;
else if (stat < 0)
   goto sect_7000;          	/*  EOF  reached  */

line[71] = '\0';
ll = CGN_INDEXC(line,'%');
if (ll < 2) goto read_loop;		/* nothing to do...  */

for (nr=2; nr<40; nr++)
   {
   m = ll + nr;
   if ((line[m] != ' ') && (line[m] != '\t'))
      break;				/* skip leading blanks or tabs */
   }


cptr = &line[m];
ll = PROC_MXLEN;
for (nr=0; nr<PROC_MXLEN; nr++)
   {
   if ((*cptr == ' ') ||
       (*cptr == '\t') ||
       (*cptr == '\0') ||
       (*cptr == '!'))
      {
      ll = nr;
      break;
      }
   cptr ++;
   }

CGN_FILL(procedure,' ',PROC_MXLEN);
(void) strncpy(procedure,&line[m],ll);


if (indx == -1)
   indx ++;
else
   {
   for (mr=0; mr<=indx*PROC_MXLEN; mr+=PROC_MXLEN)
      {
      if (strncmp(procedure,&procs[mr],PROC_MXLEN) == 0)
         goto read_loop;		 /*procedure name already there...  */
      }
   indx ++;
   }

m = indx * PROC_MXLEN;
(void) strncpy(&procs[m],procedure,PROC_MXLEN);
(void) strcpy(line,"TRANSLATE/ADD ");
m = 14;					/* length of above ... */
(void) strncpy(&line[m],procedure,PROC_MXLEN);
m += PROC_MXLEN;
line[m] = '\0';
stat = osawrite(fpo,line,m);         /*fill output file INIT.COD  */
goto read_loop;


sect_7000:                              /* 'setchan' also has to be compiled */
(void) strcpy(line,"TRANSLATE/ADD setchan  \n");
stat = osawrite(fpo,line,(int) strlen(line)); 

(void) printf("internal.kod and init.cod created...\n");
goto end_of_it;


/*  here for the problems ...  */

sect_9100:
(void) printf("problems opening internal.cod (internal.kod) ...\n");
goto end_of_it;

sect_9200:
(void) printf("problems reading internal.cod (internal.kod) ...\n");
goto end_of_it;

sect_9300:
(void) printf("problems writing internal.kod ...\n");
goto end_of_it;

sect_9400:
(void) printf("problems opening/writing file  init.cod   ...\n");
goto end_of_it;

sect_9500:
(void) printf("problems opening file  newcom.in ...\n");


end_of_it:
ospexit(0);             /*  don't bother with SCSEPI() .. */
}