/*===========================================================================
  Copyright (C) 1995-2009 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
===========================================================================*/

/*+++++++++++++++++++++ Module MIDDSC +++++++++++++++++++++++++++++++++++++++
.LANGUAGE   C
.IDENTIFICATION  MIDDSC.C
.AUTHOR   Klaus Banse		ESO - Garching
.COMMENTS
holds  MID_DRESET, type_ok, MID_DSCDIR, MID_YDSCDIR
.KEYWORDS MIDAS Descriptors
.ENVIRONMENT VMS and UNIX
.VERSION  [1.30]  861110: creation from FORTRAN version

 090326		last modif
------------------------------------------------------------------------*/
 
#include <stdlib.h>
#include <stdio.h>
#include <string.h>

#include <fileexts.h>


#define DSCDIREXTENS 30


static int   nonul = -1;
static int   old_yimno = -1;
static int   cdif = 'A' - 'a';

/*

*/

#ifdef __STDC__
void MID_DRESET(void)
#else
void MID_DRESET()
#endif

{
old_yimno = -1;
}





 
#ifdef __STDC__
int type_ok(char intyp , char outtyp)
#else
int type_ok(intyp,outtyp)
char  intyp, outtyp;
#endif
/*  return  0, if one of the types is 'H' (help)
    return -1, if bad type combination
    return  1, if good type combination (i.e. R/D)  */
{
if ((intyp == 'H') || (outtyp == 'H'))		/* ignore help descr. */
   return (0);
else if (intyp == ' ')			/* we're searching for any descr. */
   return (1);
else
   return (-1);
}
/*

*/

#ifdef __STDC__
int DSCNAM_COPY(char *out, char *in)
#else
int DSCNAM_COPY(out,in)
char  *out, *in;
#endif

{
register int  nr;

register char cr, compa;


compa = cdif;			/* avoid static (global) variable inside loop */

for (nr=0; nr<49; nr++)                 /* build up uppercase name */
   {
   cr = *in++;
   if (cr == '\0')
      {
      *out = '\0';
      return nr;			/* return length of descr. */
      }

   if ((cr >= 'a') && (cr <= 'z')) 
      *out++ = cr + compa;
   else
      {
      if (cr == ' ')
         {
         *out = '\0';
         return nr;
         }
      *out++ = cr;
      }
   }

*out = '\0';
return 49;
}
/*

*/

#ifdef __STDC__
static void procHelp(char *myhelp)
#else

static void procHelp(myhelp)
char  *myhelp;
#endif

/*++++++++++++++++++++++++++++++++++++++++++++++++++

 process the help string of a descriptor

 010910         last modif

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


{
int  n, mm;

char  *mypntr;




n = (int) strlen(myhelp);
if (n > 0)
   {
   mypntr = YDSC_PNTR->NAMESTR + YDSC_PNTR->NAMELEN + 1;

   mm = 76 - YDSC_PNTR->NAMELEN;	/* 78 - 2, because two '\0's */
   if (n > mm)
      {
      YDSC_PNTR->HELPLEN = (short int) mm;
      (void) memcpy(mypntr,myhelp,(size_t)mm);
      YDSC_PNTR->NAMESTR[77] = '\0';
      }
   else
      {
      YDSC_PNTR->HELPLEN = (short int) n;
      (void) memcpy(mypntr,myhelp,(size_t)(n+1));
      }
   }
else
   YDSC_PNTR->HELPLEN = (short int) 0;

}
/*

*/

#ifdef __STDC__
int MID_YDSCDIR(int entrx, char action, char *descr, char *type,
                int *bytelem, int *noelem, int *unit, 
                int *block, int *indx, char *help)
#else
int MID_YDSCDIR(entrx,action,descr,type,bytelem,noelem,unit,block,indx,help)
/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  interface to the descriptor directory
.ALGORITHM
  A character descriptor (name = DESCRIPTOR.DIRECTORY) is stored from 
  LDB #1 on,
  each descriptor is entered in this directory as follows:
  namestr (78 chars): name (with '\0') followed by help text (with '\0')
  descr. type (1 char), freespace (1 char);
  length of name (short int); 
  length of help text (short int); 
  unit of descr (short int) - not used yet;
  no. of bytes per descr. element (short int); 
  no. of elements of descr. (int);
  start block (int) + start index (int) withing the LDBs

  the exact structural layout is in $MID_INCLUDE/ydscext.h

  the functions provided are:
  F(ind), A(dd), D(elete) and E(xtend) a descriptor within the directory
  as well as the relevant LDB space (for Add + Extend only)

  It is assumed, that the FCB of the frame has already been read in!
.RETURNS
  stat:	I*4		return status

 030102		last modif

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

int   entrx;	/* IN : entry of frame in FCT	*/
char  action;	/* IN :	action to perform :           
			F find, D delete, A add, E extend */
char  *descr;	/* IN : descriptor name */
char  *type;	/* IO : type of descriptor: I, R, C or D */
int   *bytelem;	/* IO : no. of bytes per descr. element */
int   *noelem;	/* IO : no. of descr. elements */
int   *unit;	/* IO : unit pointer  */
int   *block;	/* OUT: starting block of descriptor on output*/
int   *indx;	/* OUT: starting index of descr. */
char  *help;	/* IO : help text name */
#endif
 
{
static char	old_descr[52] = " ", next_descr[52] = " ";
static char	dscdir[6000];

char   dsctype, *cpntra, *cpntrb, *dscpntr, tmp[100];
register char  cr;
 
int   ext, ext_len, iret;
int   found, mm1, mm2, long_len, lastlen=0;
int   dirfirst, dirused, diralloc, dscupda, totext;
int   status, ios, n, mm, chanl, extens[2];
int   foundflag, myblock, myindx;

static int   xoff;
static int   old_diroff, old_found, old_ext;
static int   next_diroff, next_found, next_ext;
register int   direntry, dirext, dirlen, diroff;
register int   nr, mr;

struct FCT_STRUCT  *fctpntr;

struct FCB_STRUCT  *fcbp;

struct LDB_STRUCT    *ldbp;

void LDBinfo();


 
	
status = ERR_NORMAL;

fctpntr = FCT.ENTRIES + entrx;
fcbp = fctpntr->FZP;
chanl = fctpntr->IOCHAN;

dscupda = 0;
dirused = fcbp->DFILLED;
dirlen = dirused;
diralloc = fcbp->DSIZE;
direntry = fcbp->DIRENTRY;
dirext = (int) fcbp->DIREXT;

myindx = -9999;

totext = diralloc/dirext;		/* no. of extens. for dsc-directory */
dscpntr = (char *) &YDSCDIR_ENTRY;		/* point to descr-dir entry */
 

                 /*  branch on action  */
 
foundflag = 0;
if (action == 'F') 
   {					/* FIND - find descriptor */
   if (entrx == old_yimno)			/* old_yimno = entrx ... */
      {
      if (strcmp(old_descr,descr) == 0)
         {
         found = old_found;
         ext = old_ext;
         diroff = old_diroff;
         foundflag = 1;
         goto descr_found;			/* use old extension */
         }
      else if (strcmp(next_descr,descr) == 0)
         {
         found = next_found;
         ext = next_ext;
         diroff = next_diroff;
         goto search_loop;
         }
      }
 
   /* init variables for search */

   ext = 1;					/* extension counter */
   diroff = 0;					/* offset within directory */
   old_yimno = -1;				/* in case, search fails... */
   next_found = 0;

	
   /*  get one directory extension after the other...  */
 
  search_loop:
   dirfirst = diroff + 1;
   dirlen = dirused - diroff;
   if (dirext < dirlen)
      dirlen = dirext;		/* read max. 2500/6000 ch. in one go... */

	
   /*  read descr `DESCRIPTOR.DIRECTORY' which holds the descr. directory */
 
   nonul = -1;
   (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,dirlen,dscdir,&nonul);
	
 
   /*  find descriptor name in directory  */
   /*  this loop has to be fast, so emulate as if assember... */ 

   cpntrb = dscdir;
   nr = 0;

  outer:
   cpntra = cpntrb;
   mr = 0;

  inner: 
   cr = descr[mr];
   if (cr != *cpntra++) goto move_on;
   if (cr == '\0')
      {
      found = nr;			/* save offset within directory */
      goto descr_found;
      }
   mr ++;
   goto inner;

  move_on:
   nr += direntry;
   if (nr < dirlen) 
      {
      cpntrb += direntry;
      goto outer;
      }
	
	
   /*  we need another segment (next extension) of descr. directory  */
 
   mm = diroff + dirext;		/* move offset up */
   if (mm < dirused)
      {
      ext ++;			/* prepare reading of next dir. segment */
      diroff = mm;
      goto search_loop;			/* and loop more... */
      }
       
   old_ext = ext;		/* end of filled directory reached */
   old_diroff = diroff;		/* may be used in descr. adding */
   return (ERR_DSCNPR);
	

  descr_found:
   cpntrb = dscdir + found;
   (void) memcpy(dscpntr,cpntrb,(size_t) direntry); /* -> YDSC entry */

   if (*type == ' ') 
      *type = YDSC_PNTR->TYPE;

   else if (*type == 'H')			/* modify help string */
      {
      procHelp(help);				/* copy help string */
      (void) 
      MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,diroff+found+1,direntry);
      goto save_info;
      }

   else if (*type != YDSC_PNTR->TYPE)
      {
      *type = YDSC_PNTR->TYPE;		/* pass back type */
       status = ERR_DSCTYP;
      }


   if (YDSC_PNTR->HELPLEN > 0) 		/* also return help string */
      {
      cpntra = YDSC_PNTR->NAMESTR+YDSC_PNTR->NAMELEN+1;
      (void) memcpy(help,cpntra,(size_t) (YDSC_PNTR->HELPLEN+1));
      }
   else
      *help = '\0';			/* no help string */
 

   *bytelem = (int) YDSC_PNTR->BYTELEM;
   if ((found == 0) && (ext == 1))         /* descr. directory is different */
      *noelem = dirused;
   else
      *noelem = YDSC_PNTR->NOELEM;
   *block = YDSC_PNTR->START;		/* get starting block */
   *indx = YDSC_PNTR->INDEX - 1;	/* get starting index-1 in stablock */
   *unit = (int) YDSC_PNTR->UNIT;
 
	
   /*  save interesting data - maybe we can use it on next call again... */
 
  save_info:
   if (foundflag != 1) 
      {
      old_yimno = entrx;
      old_found = found;
      old_ext = ext;
      old_diroff = diroff;
      (void)memcpy(old_descr,descr,(size_t)49);

      next_found = found + direntry;
      if (next_found < dirlen)
         {
         cpntra = cpntrb + direntry;
         next_ext = ext;
         next_diroff = diroff;
         (void)memcpy(next_descr,cpntra,(size_t)49);
         }
      else                              /* next_descr is in next extension */
         {
         if (ext == totext)
            next_descr[0] = '\0';	/* no next descr. */
         else
            {
            char  kdsc[52];

            next_found = 0;		/* next extension */
            next_ext = ext + 1;
            next_diroff = diroff + dirext;
            nonul = -1;
            (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,next_diroff+1,50,
                           kdsc,&nonul);
            (void)memcpy(next_descr,kdsc,(size_t)49);
            }
         }
      }
   return status;
   }


else if (action == 'A')		/* ADD - add descr entry */
   goto add_descr;


else if (action == 'a')
   {			/* ADD - add descr entry, but no 'F' before...	*/
   ios = cacheLDB(1,chanl,fcbp->PTRLDB,&ldbp);	/* get start LDB in */

   old_ext = dirused/dirext;		/* no. of last dir-ext used */
   old_diroff = old_ext * dirext;
   dirlen = dirused - old_diroff;		/* space still available */
   if (dirlen > 0)
      {
      nonul = -1;
     (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,old_diroff+1,
                       dirlen,dscdir,&nonul);
      }
   else if (dirlen < 0)
      return ERR_DSCBAD;

   /*  last extension of directory already in - add new entry in the end  */
 
  add_descr:
   if (*type == 'H')
      {
      procHelp(help);				/* copy help string */
      (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,xoff,direntry);
      return ERR_NORMAL;
      }

   diroff = old_diroff;
   dscupda = 1;			/* show that we modified the stuff */
   ext_len = diralloc;
   while ((ext_len-dirused) >= dirext) ext_len -= dirext;

   if (dirused < ext_len)	/* descr. directory extension not full yet */
      {
      found = dirused - diroff;
      dirused += direntry;	/* update directory length in use */
      goto add_3;
      }

   /*  descr. directory filled up, so extend it in the FCB  */
 
   ext_len += dirext;
   myblock = fcbp->PTRLDB;	/* link new extension for descr. directory */
   myindx = 0;
   if (diralloc >= ext_len) goto add_2;

   diralloc = ext_len;
   iret = 1;				/* set return pointer */
   goto work_b;				/* and do it ...  */
 
  add_1:
   mm1 = dirext;			/* length for addition in the end */
   mm2 = 1;
   dsctype = 'C';				/* type of descr. directory */
   goto work_a;		
	
  add_2:
   diroff = dirused;   	  /* start at first free entry in descr. directory */
   dirused += direntry;		/* already increase in_use_length */
   found = 0;
	
   /*  finally enter new entry in directory  */
 
  add_3:
   YDSC_PNTR->TYPE = *type;
   YDSC_PNTR->NAMELEN = CGN_COPY(YDSC_PNTR->NAMESTR,descr);
   YDSC_PNTR->BYTELEM = (short int) *bytelem;
   YDSC_PNTR->NOELEM = *noelem;
   YDSC_PNTR->UNIT = (short int) *unit;
   mm1 = *noelem;				/* keep number of elements */
   mm2 = *bytelem;
   YDSC_PNTR->START = fcbp->ENDLDB;
   YDSC_PNTR->INDEX = fcbp->ENDLDB_OFF;

   procHelp(help);				/* copy help string */
	
   /*  write updated directory back + reserve space for descr itself  */
 
   xoff = diroff+found+1;
   (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,xoff,direntry);
   *block = YDSC_PNTR->START;		/* for the calling program... */
   *indx = YDSC_PNTR->INDEX - 1;

   dsctype = YDSC_PNTR->TYPE;

   iret = 2;
   goto work_a;			/* after that directly to end_of_it ... */
   }

 
else if (action == 'E')		/* EXTEND - extend descr. entry	*/
   {
   found = old_found;
   diroff = old_diroff;
   lastlen = YDSC_PNTR->NOELEM;			/* save old length */
   myblock = *block;				/* keep starting LDB */
   myindx = *indx;				/* and index out of updates */
 
   YDSC_PNTR->NOELEM = *noelem;      /* update directory entry for descr. */
   (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,
                     diroff+found+1,direntry);
	
   /*  link new extension for existing descr  */
 
   iret = 2;				/* set return pointer -> "extend_1" */
   goto work_b;				/* and do it...  */
	
  extend_1:
   mm1 = *noelem - lastlen;		/* length for addition in the end */
   mm2 = (int) YDSC_PNTR->BYTELEM;
   dsctype = YDSC_PNTR->TYPE;		/* now add space at the end */
   goto work_a;
   }


else if (action == 'D')		/* DELETE - delete descr entry in directory */
   {
   if (strcmp(descr,"DESCRIPTOR.DIRECTORY") == 0)
      status = ERR_INPINV;		/* directory cannot be deleted... */
	
   else
      {
      (void) memcpy(dscpntr,dscdir+old_found,(size_t) direntry);
      YDSC_PNTR->NAMESTR[0]= '\0';
      (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,
                        0,old_diroff+old_found+1,direntry);
      (void) memcpy(dscdir+old_found,dscpntr,(size_t) direntry);

      if (old_ext == totext)
         {				/* we deleted in the last extension */
         diroff = old_diroff;		/* point already to last extension */
         dirfirst = diroff + 1;
         dirlen = dirused - diroff;	/* <= FCB.DIREXT because of `diroff' */

        pack_loop:
         mm1 = 0;
         found = 1;
         cpntrb = dscdir;

         while (found < dirlen)
            {		
            if (*cpntrb != '\0')	/* check for last filled blocks */
               mm1 = found;

            cpntrb += direntry;  found += direntry;
            }

         if (mm1 == 0)
            {				/* empty extension! */
            dscupda = 1;
            dirused -= dirlen;
            dirfirst -= dirext;
            dirlen = dirext;
            nonul = -1;
            (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,dirext,
                              dscdir,&nonul);
            goto pack_loop;
            }

         cpntrb = dscdir + mm1 - 1;	/* point to last filled block */
         dirused = dirfirst + mm1 + direntry - 2;
         dscupda = 1;
         }
      }
   goto end_of_it;
   }


else if (action == 'H')		/* return help info of last descr. */
   {
   cpntrb = dscdir + old_found;
   (void) memcpy(dscpntr,cpntrb,(size_t) direntry);  /* -> YDSC entry */
   *noelem = YDSC_PNTR->HELPLEN;
   *block = YDSC_PNTR->NAMELEN;		/* length of preceding descr name */
   return ERR_NORMAL;
   }


/* as default we display the contents of the descriptor directory in
   a user friendly way (`action' = 'Z')  */

ext = 1;					/* extension counter */
diroff = 0;					/* offset within directory */
old_yimno = -1;					/* in case, search fails... */
mm1 = 0; mm2 = 0;
	
dir_search_loop:
dirfirst = diroff + 1;
dirlen = dirused - diroff;
if (dirext < dirlen) dirlen = dirext;

nonul = -1;
(void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,dirlen,dscdir,&nonul);
	
 
/*  loop through directory extension  */
 
(void) snprintf(tmp,(size_t) 80,"Descr_dir_extension %d:",ext);
SCTPUT(tmp);				/* calling an SC routine is not nice */
SCTPUT("-----------------------");	/* but this is a debugging tool only */

cpntrb = dscdir;
nr = 0;
while (nr < dirlen)
   {					/* get stuff into structure */
   (void) memcpy(dscpntr,cpntrb,(size_t) direntry);

   if (*cpntrb == '\0')
      (void) snprintf(tmp,(size_t) 80,"Entry #%d: unused ...",mm1);
   else
      {
      (void) snprintf(tmp,(size_t) 80,
             "Entry #%d: Name = %s",mm1,YDSC_PNTR->NAMESTR);
      mm2 ++;
      }
   SCTPUT(tmp);
   (void) snprintf(tmp,(size_t) 80,
   "   Type = %c, No_elem = %d, Bytes_per_elem = %d, unit = %d",
   YDSC_PNTR->TYPE,YDSC_PNTR->NOELEM,YDSC_PNTR->BYTELEM,YDSC_PNTR->UNIT);
   SCTPUT(tmp);
   (void) snprintf(tmp,(size_t) 80,"   Start block, Index for data = %d, %d",
                  YDSC_PNTR->START,YDSC_PNTR->INDEX);
   SCTPUT(tmp);
   if (YDSC_PNTR->HELPLEN > 0)
      {
      cpntra = YDSC_PNTR->NAMESTR+YDSC_PNTR->NAMELEN+1;
      (void) snprintf(tmp,(size_t) 80,
             "   Help text: %s (%d chars)",cpntra,YDSC_PNTR->HELPLEN);
      SCTPUT(tmp);
      }

   mm1 ++;				/* increment dir_entry counter */
   cpntrb += direntry;  nr += direntry;
   }
	
	
/*  check, if we need another segment (next extension) of descr_dir  */
 
if (ext == totext)
   {
   SCTPUT("Descr. directory:");
   (void) snprintf(tmp,(size_t) 80,
             "size = %d, in_use = %d (chars)",diralloc,dirused);
   SCTPUT(tmp);
   (void) snprintf(tmp,(size_t) 80,
             "no_entries = %d, no_descr = %d (incl. direc)",mm1,mm2);
   SCTPUT(tmp);

   *bytelem = dirused;
   *noelem = mm1;
   return (ERR_NORMAL);			/* we're done */
   }
 
ext ++ ;		/* prepare reading of next directory segment */
diroff += dirext;
goto dir_search_loop;			/* and loop more... */






/* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^	
	
   working section for reserving space for a descr
	
   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */
	
work_a:
ext_len = LDB_NDSCRW1;			/* index will move from 0 on... */
					/* read last used LDB */
ios = cacheLDB(1,chanl,fcbp->ENDLDB,&ldbp);	/* read last used LDB */
myindx = (int) fcbp->ENDLDB_OFF - 1;	/* remember that arrays begin with 0  */
	

/*  determine no. of elements + length in 4-byte words  */
 
if ( (dsctype == 'I') || (dsctype == 'R') )
   long_len = mm1;
else if (dsctype == 'D')
   {
   n = DD_SIZE / II_SIZE;		/* no. of integers in a double */
   mm1 *= n;			/* double prec. looks internally as int */
   long_len = mm1;
   }
else if (dsctype == 'S')
   {
   n = SS_SIZE / II_SIZE;		/* no. of size_t in a double */
   mm1 *= n;			/* size_t looks internally as int */
   long_len = mm1;
   }
else				/* for type C */
   {
   mm1 *= mm2;
   long_len = (mm1 + (II_SIZE-1)) / II_SIZE;
   }
	
ldbp->LDBWORDS.IWORD[myindx] = mm1;		/* store 1. header lword */
 
if (myindx == ext_len)	/* test, if 2. header lword still in same LDB ... */
   {
   status = MID_CRELDB(entrx,ldbp);			
   if (status != ERR_NORMAL) goto end_of_it;

   ldbp->LDBWORDS.IWORD[0] = -1;		/* currently no extension... */
   ldbp->LDBWORDS.IWORD[1] = 0;			/* index = 0 */
   myindx = 1;
   }
else
   {
   myindx ++;
   ldbp->LDBWORDS.IWORD[myindx] = -1;	/* currently no extension... */
   if (myindx == ext_len) 	    /* see, if 2. header lword in same LDB */
      {
      status = MID_CRELDB(entrx,ldbp);	
      if (status != ERR_NORMAL) goto end_of_it;

      myindx = 0;
      }
   else
      myindx ++;
 
   ldbp->LDBWORDS.IWORD[myindx] = 0;			/* index = 0  */
   }
 
myindx += (long_len + 1) ;
	
 
while (myindx > ext_len)			/* we need more LDBs */
   {
   status = MID_CRELDB(entrx,ldbp);		/* get new LDB + link it in */
   if (status != ERR_NORMAL) goto end_of_it;

   myindx -= LDB_NDSCRW;
   }
 
ios = cacheLDB(2,chanl,ldbp->BLKNUM,&ldbp);	
	
/*  and update FCB (FCB.ENDLDB counts from 1 on) */
 
fcbp->ENDLDB = (unsigned int) ldbp->BLKNUM;
fcbp->ENDLDB_OFF = (unsigned int) (myindx + 1);	
if (iret == 1)
   goto add_2;
else 
   goto end_of_it;
 
 


/* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^	
	
   working section for extending + linking descriptors...
	
   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */
	
work_b:
ext_len = LDB_NDSCRW1;			/* index will move from 0 on... */
ios = cacheLDB(1,chanl,myblock,&ldbp);	/* read last used LDB */
 
while (1)
   {
   LDBinfo(chanl,ldbp,myindx,&mm,extens);
					/* get pointers only */
   if (extens[0] != -1)
      {
      myblock = extens[0];
      myindx = extens[1] - 1;		/* on disk file FORTRAN indexing */
      if (ldbp->BLKNUM != myblock)
         ios = cacheLDB(1,chanl,myblock,&ldbp);	/* get start LDB of descr. */
      }
   else
      {
      if (ldbp->BLKNUM != myblock)
         ios = cacheLDB(1,chanl,myblock,&ldbp);	/* get start LDB of descr. */
      break;				/* already get out of loop...  */
      }
   }
	
ldbp->LDBWORDS.IWORD[myindx] = mm;
if (myindx == ext_len)	/* test, if 2. header lword still in same LDB ... */
   {
   status = MID_CRELDB(entrx,ldbp);
   if (status != ERR_NORMAL) goto end_of_it;

   ldbp->LDBWORDS.IWORD[0] = (int) fcbp->ENDLDB;	/* store 2. header word */
   ldbp->LDBWORDS.IWORD[1] = (int) fcbp->ENDLDB_OFF;	/* store 3. header word */
   }
else
   {
   myindx ++;
   ldbp->LDBWORDS.IWORD[myindx] =	/* store 2. header word */
         (int) fcbp->ENDLDB;	
   if (myindx == ext_len)	/* see, if 3. header word still in same LDB */
      {
      status = MID_CRELDB(entrx,ldbp);
      if (status != ERR_NORMAL) goto end_of_it;

      myindx = 0;
      }
   else
      myindx ++;
 
   ldbp->LDBWORDS.IWORD[myindx] = 		/* store 3. header word */
         (int) fcbp->ENDLDB_OFF;
   }
 
ios = cacheLDB(2,chanl,ldbp->BLKNUM,&ldbp);	/* update LDB */
if (iret == 1)
   goto add_1;
else
   goto extend_1;		/* go back to where we came from... */





/* ......

   that's it folks...

   ...... */

end_of_it:
if (dscupda == 1)
   {
   fcbp->DFILLED = dirused;
   fcbp->DSIZE = diralloc;
   }
old_descr[0] = '\0';

if (status != ERR_NORMAL)
   MID_ERROR("MIDAS","MID_YDSCDIR:",status,0);

return status;
}


