/* @(#)middsc.c 17.1.1.2 (ESO-DMD) 02/25/02 17:53: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 ===========================================================================*/ /*+++++++++++++++++++++ Module MIDDSC +++++++++++++++++++++++++++++++++++++++ .LANGUAGE C .IDENTIFICATION MIDDSC.C .AUTHOR Klaus Banse ESO - Garching .COMMENTS holds MID_DRESET, tyype_ok, MID_DSCDIR, MID_ZDSCDIR, MID_YDSCDIR .KEYWORDS MIDAS Descriptors .ENVIRONMENT VMS and UNIX .VERSION [1.30] 861110: creation from FORTRAN version ------------------------------------------------------------------------*/ #include #include #define DSCDIREXTENS 30 static int nonul = -1; static int old_zimno = -1, old_yimno = -1; static int cdif = 'A' - 'a'; static int dirb2 = 2*DSCDIREXTENS, dirb3 = 3*DSCDIREXTENS; /* */ #ifdef __STDC__ void MID_DRESET(void) #else void MID_DRESET() #endif { old_zimno = -1; 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__ void procHelp(char *myhelp) #else 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_ZDSCDIR(int entrx, char action, char *descr, int dsclen, char *type, int *bytelem, int *noelem, int *unit, int *block, int *indx) #else int MID_ZDSCDIR(entrx,action,descr,dsclen,type,bytelem,noelem,unit,block,indx) /*++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE interface to the descriptor directory .ALGORITHM A character descriptor (name = DESCRIPTOR.DIRECTORY) of initial length 1500 is stored from LDB #1 on, each descriptor is entered in this directory as follows: no. of direc_blocks (ch*1), padding_flag (ch*1) = ' ' or '_', unit of descr (short int), no. of bytes per descr. element (int), no. of elements (int), start block (int) + start index (int) withing the LDBs no. of elements of help text (int), start block (int) + start index (int) of help text, descr. type (1 char) and descr. name terminated by '\0' of length < 27, or < 57 or < 87 chars. => 2 or 3 or 4 direc_entries - the exact structural layout is in $MID_INCLUDE/zdscext.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 010411 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 */ int dsclen; /* IN : length of descriptor */ 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 */ int *indx; /* OUT: starting index of descr. */ #endif { static char old_descr[52] = " ", next_descr[52] = " "; static char dscdir[1500]; char dsctype, *cpntra, *cpntrb, *dscpntr, cdummy[4], tmp[80]; char *kpntra, *kpntrb; int ext, ext_len, iret; int found, mm1, mm2, long_len, lastlen; int dirfirst, dirused, diralloc, dirlen, diroff, dscupda, totext; int status, ios, n, mm, chanl, extens[2]; int foundflag, dirbytes, myblock, myindx, idummy; static int dirln30; static int old_diroff, old_found, old_ext, old_dirb; static int next_diroff, next_found, next_ext, next_dirb; static int xoff, xbytes; register int nr; float rdummy; struct FCT_STRUCT *fctpntr; struct FCB_STRUCT *fcbp; struct LDB_STRUCT *ldbp; status = ERR_NORMAL; fctpntr = FCT.ENTRIES + entrx; fcbp = fctpntr->FZP; chanl = fctpntr->IOCHAN; dscupda = 0; dirused = fcbp->DFILLED; diralloc = fcbp->DSIZE; totext = diralloc/fcbp->DIREXT; /* no. of extens. for dsc-directory */ dscpntr = (char *) &ZDSCDIR_ENTRY; /* pojnt to descr-dir entry */ /* branch on action */ if (action == 'F') goto find_descr; else if (action == 'A') /* add descr. */ goto add_descr; else if (action == 'a') /* as 'A' but no 'F' before... */ { status = cacheLDB(1,chanl,fcbp->PTRLDB,&ldbp); /* get start LDB in */ if (status != ERR_NORMAL) return status; if (*type == 'H') /* just add help text, descr already found */ goto add_descr; else goto find_descr; } else if (action == 'E') /* extend descr. */ goto extend_descr; else if (action == 'D') /* delete descr. */ goto delete_descr; else if (action == 'H') /* return help info of last descr. */ { cpntrb = dscdir + old_found; CGN_COPYALL(dscpntr,cpntrb,90); /* from directory to ZDSC entry */ *noelem = ZDSC_PNTR->HNOELEM; *block = ZDSC_PNTR->HSTART; /* get starting block */ *indx = ZDSC_PNTR->HINDEX - 1; /* of help text */ 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_zimno = -1; /* in case, search fails... */ mm1 = 0; mm2 = 0; dir_search_loop: dirfirst = diroff + 1; dirlen = dirused - diroff; if (fcbp->DIREXT < dirlen) dirlen = fcbp->DIREXT; nonul = -1; (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,dirlen,dscdir,&nonul); /* loop through directory extension */ (void) sprintf(tmp,"Descr_dir_extension %d:",ext); SCTPUT(tmp); /* calling an SC routine is not very */ SCTPUT("-----------------------"); /* but this is a debugging tool only */ cpntrb = dscdir; nr = 0; while (nr < dirlen) { if (*cpntrb == '2') dirbytes = dirb2; else if (*cpntrb == '3') dirbytes = dirb3; else dirbytes = fcbp->DIRENTRY; CGN_COPYALL(dscpntr,cpntrb,dirbytes); /* get stuff into structure */ if (*(cpntrb+1) == '_') { (void) sprintf(tmp, "*** Descr_dir_entry #%d uses %c basic blocks for padding ****", mm1,*cpntrb); SCTPUT(tmp); } else { mm2 ++; /* increment dir_entry counter */ (void) sprintf(tmp,"Descr_dir_entry #%d uses %c basic blocks", mm1,*cpntrb); SCTPUT(tmp); (void) sprintf(tmp,"Name = %s",ZDSC_PNTR->NAME); SCTPUT(tmp); (void) sprintf(tmp, " Type = %c, No_elem = %d, Bytes_per_elem = %d, unit = %d", ZDSC_PNTR->TYPE,ZDSC_PNTR->NOELEM,ZDSC_PNTR->BYTELEM,ZDSC_PNTR->UNIT); SCTPUT(tmp); (void) sprintf(tmp," Start block, Index for data = %d, %d", ZDSC_PNTR->START,ZDSC_PNTR->INDEX); SCTPUT(tmp); if (ZDSC_PNTR->HNOELEM > 0) { (void) sprintf(tmp, " Help text = %d chars, Start block, Index = %d, %d", ZDSC_PNTR->HNOELEM,ZDSC_PNTR->HSTART,ZDSC_PNTR->HINDEX); SCTPUT(tmp); } } mm1 ++; /* increment dir_entry counter */ cpntrb += dirbytes; nr += dirbytes; } /* check, if we need another segment (next extension) of descr_dir */ if (ext == totext) { SCTPUT("Descr. directory:"); (void) sprintf(tmp,"size = %d, in_use = %d (chars)",diralloc,dirused); SCTPUT(tmp); (void) sprintf(tmp,"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 += fcbp->DIREXT; goto dir_search_loop; /* and loop more... */ /* ...... FIND - find descriptor ...... */ find_descr: foundflag = 0; if (action == 'a') { old_ext = dirused/fcbp->DIREXT; /* no. of last dir-ext used */ old_diroff = old_ext * fcbp->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; goto add_descr; } if (entrx == old_zimno) /* old_zimno = entrx ... */ { if (strcmp(old_descr,descr) == 0) { found = old_found; ext = old_ext; diroff = old_diroff; dirbytes = old_dirb; foundflag = 1; goto descr_found; /* use old extension */ } else if (strcmp(next_descr,descr) == 0) { found = next_found; ext = next_ext; diroff = next_diroff; dirbytes = next_dirb; goto search_loop; } } /* init variables for search */ ext = 1; /* extension counter */ diroff = 0; /* offset within directory */ old_zimno = -1; /* in case, search fails... */ next_found = 0; /* get one directory extension after the other... */ search_loop: dirfirst = diroff + 1; dirlen = dirused - diroff; if (fcbp->DIREXT < dirlen) dirlen = fcbp->DIREXT; /* read max. 1500 chars. at one go... */ /* read descriptor `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 */ nr = next_found; cpntrb = dscdir + nr; cpntra = cpntrb + 33; /* skip over int info + TYPE */ dirln30 = dirlen - 30; /* at least 2 blocks for descr name */ while (nr < dirln30) { if (*cpntrb == '3') dirbytes = dirb3; else dirbytes = dirb2; /* also mm=1 is possible, but then the extension is at the end anyway */ if (strcmp(cpntra,descr) == 0) { found = nr; /* save offset within directory */ goto descr_found; } cpntra += dirbytes; cpntrb += dirbytes; nr += dirbytes; } /* we need another segment (next extension) of descr. directory */ if (ext == totext) /* descr. does not exist... */ { old_ext = ext; old_diroff = diroff; /* maybe used in descr. adding */ return (ERR_DSCNPR); } mm = diroff + fcbp->DIREXT; /* move offset up */ if (mm < dirused) { ext ++ ; /* prepare reading of next dir. segment */ diroff = mm; goto search_loop; /* and loop more... */ } else { /* not at last extension yet, */ old_ext = ext; /* but end of filled directory reached */ old_diroff = diroff; /* maybe used in descr. adding */ return (ERR_DSCNPR); } descr_found: cpntrb = dscdir + found; CGN_COPYALL(dscpntr,cpntrb,dirbytes); /* from directory to ZDSC entry */ if (*type == ' ') *type = ZDSC_PNTR->TYPE; else if (*type == 'H') { *noelem = ZDSC_PNTR->HNOELEM; if (*noelem == 0) status = ERR_NODATA; *block = ZDSC_PNTR->HSTART; /* get starting block */ *indx = ZDSC_PNTR->HINDEX - 1; /* of help text */ goto save_info; } else if (*type != ZDSC_PNTR->TYPE) { *type = ZDSC_PNTR->TYPE; /* pass back type */ status = ERR_DSCTYP; } *bytelem = (int) ZDSC_PNTR->BYTELEM; if ((found == 0) && (ext == 1)) /* descr. directory is different */ *noelem = dirused; else *noelem = ZDSC_PNTR->NOELEM; *block = ZDSC_PNTR->START; /* get starting block */ *indx = ZDSC_PNTR->INDEX - 1; /* get starting index-1 in stablock */ *unit = ZDSC_PNTR->UNIT; /* save interesting data - maybe we can use it on next call again... */ save_info: if (foundflag != 1) { old_zimno = entrx; old_found = found; old_ext = ext; old_diroff = diroff; old_dirb = dirbytes; (void)strcpy(old_descr,descr); next_found = found + dirbytes; if (next_found < dirln30) { kpntrb = cpntrb + dirbytes; kpntra = kpntrb + 33; if (*kpntrb == '3') next_dirb = dirb3; else next_dirb = dirb2; next_ext = ext; next_diroff = diroff; (void)strcpy(next_descr,kpntra); } else /* next_descr is in next extension */ { if (ext == totext) (void) strcpy(next_descr," "); /* no next descr. */ else { char kdscdir[124]; next_found = 0; /* next extension */ next_ext = ext + 1; next_diroff = diroff + fcbp->DIREXT; nonul = -1; (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,next_diroff+1,120, kdscdir,&nonul); kpntrb = kdscdir; kpntra = kpntrb + 33; if (*kpntrb == '3') next_dirb = dirb3; else next_dirb = dirb2; (void)strcpy(next_descr,kpntra); } } } return status; /* ...... DELETE - delete descr entry in directory ...... */ delete_descr: if (strcmp(descr,"DESCRIPTOR.DIRECTORY") == 0) status = ERR_INPINV; /* directory may not be deleted... */ else { CGN_COPYALL(dscpntr,dscdir+old_found,old_dirb); ZDSC_PNTR->NOBLK[1]= '_'; ZDSC_PNTR->NAME[0]= '\0'; (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr, 0,old_diroff+old_found+1,old_dirb); CGN_COPYALL(dscdir+old_found,dscpntr,old_dirb); 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; cpntra = cpntrb + 1; while (found < dirlen) { /* always take chunks of 30 chars. */ if (*cpntrb == '3') dirbytes = dirb3; else if (*cpntrb == '2') dirbytes = dirb2; else dirbytes = fcbp->DIRENTRY; if (*cpntra == ' ') /* check for last filled blocks */ mm1 = found; cpntra += dirbytes; cpntrb += dirbytes; found += dirbytes; } if (mm1 == 0) { /* empty extension! */ dscupda = 1; dirused -= dirlen; dirfirst -= fcbp->DIREXT; dirlen = fcbp->DIREXT; nonul = -1; (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,fcbp->DIREXT, dscdir,&nonul); goto pack_loop; } cpntrb = dscdir + mm1 - 1; /* last filled block */ if (*cpntrb == '3') dirbytes = dirb3; else if (*cpntrb == '2') dirbytes = dirb2; else dirbytes = fcbp->DIRENTRY; found = mm1 + dirbytes - 1; dirused = dirfirst + found - 1; dscupda = 1; } } goto end_of_it; /* ...... ADD - add descr entry type, bytelem, noelem are input parms ...... */ /* last extension of directory already in - add new entry in the end */ add_descr: if (*type == 'H') /* just add help text, descr already found */ { mm1 = *noelem; mm2 = 1; /* flat text */ ZDSC_PNTR->HNOELEM = mm1; ZDSC_PNTR->HSTART = fcbp->ENDLDB[0]; ZDSC_PNTR->HINDEX = fcbp->ENDLDB[1]; *block = ZDSC_PNTR->HSTART; /* for the calling program */ *indx = ZDSC_PNTR->HINDEX - 1; if (action == 'a') (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,xoff,xbytes); else (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr, 0,old_diroff+old_found+1,old_dirb); dsctype = 'C'; iret = 2; goto work_a; } dirbytes = dirb2; /* most common case */ cdummy[0] = '2'; if (dsclen > 26) /* name length -> no. of direc_entries */ { dirbytes = dirb3; cdummy[0] = '3'; } diroff = old_diroff; dscupda = 1; /* show that we modified the stuff */ ext_len = diralloc; while ((ext_len-dirused) >= fcbp->DIREXT) ext_len -= fcbp->DIREXT; if (dirused < ext_len) /* descr. directory extension not full yet */ { found = dirused - diroff; if ((dirused+dirbytes) <= ext_len) { dirused += dirbytes; /* update directory length in use */ goto add_3; } mm = ext_len - dirused; /* fill with '\0' */ dscpntr = dscdir + found; CGN_FILL(dscpntr,'\0',mm); /* to avoid UMR errors in Purify ... */ if (mm == 30) /* only set no of dscdir_entries */ *dscpntr = '1'; else if (mm == 60) *dscpntr = '2'; else if (mm == 90) *dscpntr = '3'; /* cannot be 120 ... */ else return (ERR_DSCBAD); /* we should not come here... */ *(dscpntr+1) = '_'; /* indicate that's empty */ (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,diroff+found+1,mm); dirused = ext_len; /* now `diruse' = `ext_len' */ dscpntr = (char *) &ZDSCDIR_ENTRY; /* reset `dscpntr' */ } /* descr. directory filled up, so extend it in the FCB */ ext_len += fcbp->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 = fcbp->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 += dirbytes; /* already increase in_use_length */ found = 0; /* finally enter new entry in directory */ add_3: ZDSC_PNTR->NOBLK[0] = cdummy[0]; /* indicate how many basic blocks */ ZDSC_PNTR->NOBLK[1] = ' '; ZDSC_PNTR->TYPE = *type; (void)strcpy(ZDSC_PNTR->NAME,descr); ZDSC_PNTR->BYTELEM = (unsigned short int) *bytelem; ZDSC_PNTR->NOELEM = *noelem; ZDSC_PNTR->UNIT = *unit; mm1 = *noelem; /* keep number of elements */ mm2 = *bytelem; ZDSC_PNTR->START = fcbp->ENDLDB[0]; ZDSC_PNTR->INDEX = fcbp->ENDLDB[1]; ZDSC_PNTR->HNOELEM = 0; ZDSC_PNTR->HSTART = 0; ZDSC_PNTR->HINDEX = 0; /* write updated directory back + reserve space for descr itself */ xoff = diroff + found + 1; /* may be needed later */ xbytes = dirbytes; (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,xoff,dirbytes); *block = ZDSC_PNTR->START; /* for the calling program... */ *indx = ZDSC_PNTR->INDEX - 1; dsctype = ZDSC_PNTR->TYPE; iret = 2; goto work_a; /* after that directly to end_of_it ... */ /* ...... EXTEND - extend descr. entry type, noelem are input parms ...... */ extend_descr: found = old_found; diroff = old_diroff; dirbytes = old_dirb; if (*type == 'H') { lastlen = ZDSC_PNTR->HNOELEM; /* save old length */ ZDSC_PNTR->HNOELEM = *noelem; } else { lastlen = ZDSC_PNTR->NOELEM; /* save old length */ ZDSC_PNTR->NOELEM = *noelem; /* update directory entry for descr. */ } myblock = *block; /* keep starting LDB */ myindx = *indx; /* and index out of updates */ (void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,diroff+found+1,dirbytes); /* 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 */ if (*type == 'H') { mm2 = 1; /* flat char. string */ dsctype = 'C'; } else { mm2 = (int) ZDSC_PNTR->BYTELEM; dsctype = ZDSC_PNTR->TYPE; /* now add space at the end */ } /* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 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[0],&ldbp); /* read last used LDB */ myindx = fcbp->ENDLDB[1] - 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 /* 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 */ fcbp->ENDLDB[0] = ldbp->BLKNUM; fcbp->ENDLDB[1] = myindx + 1; /* FCB.ENDLDB counts from 1 on */ 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) { mm = 0; (void) MID_RDLDB(chanl,ldbp,myindx,1,&idummy,&rdummy,cdummy,1,&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] = fcbp->ENDLDB[0]; /* store 2. header word */ ldbp->LDBWORDS.IWORD[1] = fcbp->ENDLDB[1]; /* store 3. header word */ } else { myindx ++; ldbp->LDBWORDS.IWORD[myindx] = /* store 2. header word */ fcbp->ENDLDB[0]; 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 */ fcbp->ENDLDB[1]; } 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] = '!'; if (status != ERR_NORMAL) MID_ERROR("MIDAS","MID_ZDSCDIR:",status,0); return status; } /* */ #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) of initial length 2500 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 020207 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[2500]; char dsctype, *cpntra, *cpntrb, *dscpntr, tmp[100]; register char cr; int ext, ext_len, iret; int found, mm1, mm2, long_len, lastlen; 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; 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; 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 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, but no 'F' before... */ status = cacheLDB(1,chanl,fcbp->PTRLDB,&ldbp); /* get start LDB in */ if (status != ERR_NORMAL) return status; 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[0]; YDSC_PNTR->INDEX = fcbp->ENDLDB[1]; 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 == 'A') /* ADD - add descr entry */ goto add_descr; 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) sprintf(tmp,"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 */ memcpy(dscpntr,cpntrb,(size_t) direntry); if (*cpntrb == '\0') (void) sprintf(tmp,"Entry #%d: unused ...",mm1); else { (void) sprintf(tmp,"Entry #%d: Name = %s",mm1,YDSC_PNTR->NAMESTR); mm2 ++; } SCTPUT(tmp); (void) sprintf(tmp, " 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) sprintf(tmp," 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) sprintf(tmp, " 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) sprintf(tmp,"size = %d, in_use = %d (chars)",diralloc,dirused); SCTPUT(tmp); (void) sprintf(tmp,"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[0],&ldbp); /* read last used LDB */ myindx = fcbp->ENDLDB[1] - 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 /* 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 */ fcbp->ENDLDB[0] = ldbp->BLKNUM; fcbp->ENDLDB[1] = myindx + 1; /* FCB.ENDLDB counts from 1 on */ 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) { (void) 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] = fcbp->ENDLDB[0]; /* store 2. header word */ ldbp->LDBWORDS.IWORD[1] = fcbp->ENDLDB[1]; /* store 3. header word */ } else { myindx ++; ldbp->LDBWORDS.IWORD[myindx] = /* store 2. header word */ fcbp->ENDLDB[0]; 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 */ fcbp->ENDLDB[1]; } 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; }