1
/*===========================================================================
2
Copyright (C) 1995-2009 European Southern Observatory (ESO)
4
This program is free software; you can redistribute it and/or
5
modify it under the terms of the GNU General Public License as
6
published by the Free Software Foundation; either version 2 of
7
the License, or (at your option) any later version.
9
This program is distributed in the hope that it will be useful,
10
but WITHOUT ANY WARRANTY; without even the implied warranty of
11
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12
GNU General Public License for more details.
14
You should have received a copy of the GNU General Public
15
License along with this program; if not, write to the Free
16
Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
19
Correspondence concerning ESO-MIDAS should be addressed as follows:
20
Internet e-mail: midas@eso.org
21
Postal address: European Southern Observatory
22
Data Management Division
23
Karl-Schwarzschild-Strasse 2
24
D 85748 Garching bei Muenchen
26
===========================================================================*/
28
/*+++++++++++++++++++++ Module MIDDSC +++++++++++++++++++++++++++++++++++++++
30
.IDENTIFICATION MIDDSC.C
31
.AUTHOR Klaus Banse ESO - Garching
33
holds MID_DRESET, type_ok, MID_DSCDIR, MID_YDSCDIR
34
.KEYWORDS MIDAS Descriptors
35
.ENVIRONMENT VMS and UNIX
36
.VERSION [1.30] 861110: creation from FORTRAN version
39
------------------------------------------------------------------------*/
48
#define DSCDIREXTENS 30
51
static int nonul = -1;
52
static int old_yimno = -1;
53
static int cdif = 'A' - 'a';
75
int type_ok(char intyp , char outtyp)
77
int type_ok(intyp,outtyp)
80
/* return 0, if one of the types is 'H' (help)
81
return -1, if bad type combination
82
return 1, if good type combination (i.e. R/D) */
84
if ((intyp == 'H') || (outtyp == 'H')) /* ignore help descr. */
86
else if (intyp == ' ') /* we're searching for any descr. */
96
int DSCNAM_COPY(char *out, char *in)
98
int DSCNAM_COPY(out,in)
105
register char cr, compa;
108
compa = cdif; /* avoid static (global) variable inside loop */
110
for (nr=0; nr<49; nr++) /* build up uppercase name */
116
return nr; /* return length of descr. */
119
if ((cr >= 'a') && (cr <= 'z'))
140
static void procHelp(char *myhelp)
143
static void procHelp(myhelp)
147
/*++++++++++++++++++++++++++++++++++++++++++++++++++
149
process the help string of a descriptor
153
--------------------------------------------------*/
164
n = (int) strlen(myhelp);
167
mypntr = YDSC_PNTR->NAMESTR + YDSC_PNTR->NAMELEN + 1;
169
mm = 76 - YDSC_PNTR->NAMELEN; /* 78 - 2, because two '\0's */
172
YDSC_PNTR->HELPLEN = (short int) mm;
173
(void) memcpy(mypntr,myhelp,(size_t)mm);
174
YDSC_PNTR->NAMESTR[77] = '\0';
178
YDSC_PNTR->HELPLEN = (short int) n;
179
(void) memcpy(mypntr,myhelp,(size_t)(n+1));
183
YDSC_PNTR->HELPLEN = (short int) 0;
191
int MID_YDSCDIR(int entrx, char action, char *descr, char *type,
192
int *bytelem, int *noelem, int *unit,
193
int *block, int *indx, char *help)
195
int MID_YDSCDIR(entrx,action,descr,type,bytelem,noelem,unit,block,indx,help)
196
/*++++++++++++++++++++++++++++++++++++++++++++++++++
198
interface to the descriptor directory
200
A character descriptor (name = DESCRIPTOR.DIRECTORY) is stored from
202
each descriptor is entered in this directory as follows:
203
namestr (78 chars): name (with '\0') followed by help text (with '\0')
204
descr. type (1 char), freespace (1 char);
205
length of name (short int);
206
length of help text (short int);
207
unit of descr (short int) - not used yet;
208
no. of bytes per descr. element (short int);
209
no. of elements of descr. (int);
210
start block (int) + start index (int) withing the LDBs
212
the exact structural layout is in $MID_INCLUDE/ydscext.h
214
the functions provided are:
215
F(ind), A(dd), D(elete) and E(xtend) a descriptor within the directory
216
as well as the relevant LDB space (for Add + Extend only)
218
It is assumed, that the FCB of the frame has already been read in!
220
stat: I*4 return status
224
--------------------------------------------------*/
226
int entrx; /* IN : entry of frame in FCT */
227
char action; /* IN : action to perform :
228
F find, D delete, A add, E extend */
229
char *descr; /* IN : descriptor name */
230
char *type; /* IO : type of descriptor: I, R, C or D */
231
int *bytelem; /* IO : no. of bytes per descr. element */
232
int *noelem; /* IO : no. of descr. elements */
233
int *unit; /* IO : unit pointer */
234
int *block; /* OUT: starting block of descriptor on output*/
235
int *indx; /* OUT: starting index of descr. */
236
char *help; /* IO : help text name */
240
static char old_descr[52] = " ", next_descr[52] = " ";
241
static char dscdir[6000];
243
char dsctype, *cpntra, *cpntrb, *dscpntr, tmp[100];
246
int ext, ext_len, iret;
247
int found, mm1, mm2, long_len, lastlen=0;
248
int dirfirst, dirused, diralloc, dscupda, totext;
249
int status, ios, n, mm, chanl, extens[2];
250
int foundflag, myblock, myindx;
253
static int old_diroff, old_found, old_ext;
254
static int next_diroff, next_found, next_ext;
255
register int direntry, dirext, dirlen, diroff;
258
struct FCT_STRUCT *fctpntr;
260
struct FCB_STRUCT *fcbp;
262
struct LDB_STRUCT *ldbp;
271
fctpntr = FCT.ENTRIES + entrx;
273
chanl = fctpntr->IOCHAN;
276
dirused = fcbp->DFILLED;
278
diralloc = fcbp->DSIZE;
279
direntry = fcbp->DIRENTRY;
280
dirext = (int) fcbp->DIREXT;
284
totext = diralloc/dirext; /* no. of extens. for dsc-directory */
285
dscpntr = (char *) &YDSCDIR_ENTRY; /* point to descr-dir entry */
288
/* branch on action */
292
{ /* FIND - find descriptor */
293
if (entrx == old_yimno) /* old_yimno = entrx ... */
295
if (strcmp(old_descr,descr) == 0)
301
goto descr_found; /* use old extension */
303
else if (strcmp(next_descr,descr) == 0)
307
diroff = next_diroff;
312
/* init variables for search */
314
ext = 1; /* extension counter */
315
diroff = 0; /* offset within directory */
316
old_yimno = -1; /* in case, search fails... */
320
/* get one directory extension after the other... */
323
dirfirst = diroff + 1;
324
dirlen = dirused - diroff;
326
dirlen = dirext; /* read max. 2500/6000 ch. in one go... */
329
/* read descr `DESCRIPTOR.DIRECTORY' which holds the descr. directory */
332
(void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,dirlen,dscdir,&nonul);
335
/* find descriptor name in directory */
336
/* this loop has to be fast, so emulate as if assember... */
347
if (cr != *cpntra++) goto move_on;
350
found = nr; /* save offset within directory */
365
/* we need another segment (next extension) of descr. directory */
367
mm = diroff + dirext; /* move offset up */
370
ext ++; /* prepare reading of next dir. segment */
372
goto search_loop; /* and loop more... */
375
old_ext = ext; /* end of filled directory reached */
376
old_diroff = diroff; /* may be used in descr. adding */
381
cpntrb = dscdir + found;
382
(void) memcpy(dscpntr,cpntrb,(size_t) direntry); /* -> YDSC entry */
385
*type = YDSC_PNTR->TYPE;
387
else if (*type == 'H') /* modify help string */
389
procHelp(help); /* copy help string */
391
MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,diroff+found+1,direntry);
395
else if (*type != YDSC_PNTR->TYPE)
397
*type = YDSC_PNTR->TYPE; /* pass back type */
402
if (YDSC_PNTR->HELPLEN > 0) /* also return help string */
404
cpntra = YDSC_PNTR->NAMESTR+YDSC_PNTR->NAMELEN+1;
405
(void) memcpy(help,cpntra,(size_t) (YDSC_PNTR->HELPLEN+1));
408
*help = '\0'; /* no help string */
411
*bytelem = (int) YDSC_PNTR->BYTELEM;
412
if ((found == 0) && (ext == 1)) /* descr. directory is different */
415
*noelem = YDSC_PNTR->NOELEM;
416
*block = YDSC_PNTR->START; /* get starting block */
417
*indx = YDSC_PNTR->INDEX - 1; /* get starting index-1 in stablock */
418
*unit = (int) YDSC_PNTR->UNIT;
421
/* save interesting data - maybe we can use it on next call again... */
430
(void)memcpy(old_descr,descr,(size_t)49);
432
next_found = found + direntry;
433
if (next_found < dirlen)
435
cpntra = cpntrb + direntry;
437
next_diroff = diroff;
438
(void)memcpy(next_descr,cpntra,(size_t)49);
440
else /* next_descr is in next extension */
443
next_descr[0] = '\0'; /* no next descr. */
448
next_found = 0; /* next extension */
450
next_diroff = diroff + dirext;
452
(void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,next_diroff+1,50,
454
(void)memcpy(next_descr,kdsc,(size_t)49);
462
else if (action == 'A') /* ADD - add descr entry */
466
else if (action == 'a')
467
{ /* ADD - add descr entry, but no 'F' before... */
468
ios = cacheLDB(1,chanl,fcbp->PTRLDB,&ldbp); /* get start LDB in */
470
old_ext = dirused/dirext; /* no. of last dir-ext used */
471
old_diroff = old_ext * dirext;
472
dirlen = dirused - old_diroff; /* space still available */
476
(void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,old_diroff+1,
477
dirlen,dscdir,&nonul);
482
/* last extension of directory already in - add new entry in the end */
487
procHelp(help); /* copy help string */
488
(void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,xoff,direntry);
493
dscupda = 1; /* show that we modified the stuff */
495
while ((ext_len-dirused) >= dirext) ext_len -= dirext;
497
if (dirused < ext_len) /* descr. directory extension not full yet */
499
found = dirused - diroff;
500
dirused += direntry; /* update directory length in use */
504
/* descr. directory filled up, so extend it in the FCB */
507
myblock = fcbp->PTRLDB; /* link new extension for descr. directory */
509
if (diralloc >= ext_len) goto add_2;
512
iret = 1; /* set return pointer */
513
goto work_b; /* and do it ... */
516
mm1 = dirext; /* length for addition in the end */
518
dsctype = 'C'; /* type of descr. directory */
522
diroff = dirused; /* start at first free entry in descr. directory */
523
dirused += direntry; /* already increase in_use_length */
526
/* finally enter new entry in directory */
529
YDSC_PNTR->TYPE = *type;
530
YDSC_PNTR->NAMELEN = CGN_COPY(YDSC_PNTR->NAMESTR,descr);
531
YDSC_PNTR->BYTELEM = (short int) *bytelem;
532
YDSC_PNTR->NOELEM = *noelem;
533
YDSC_PNTR->UNIT = (short int) *unit;
534
mm1 = *noelem; /* keep number of elements */
536
YDSC_PNTR->START = fcbp->ENDLDB;
537
YDSC_PNTR->INDEX = fcbp->ENDLDB_OFF;
539
procHelp(help); /* copy help string */
541
/* write updated directory back + reserve space for descr itself */
543
xoff = diroff+found+1;
544
(void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,xoff,direntry);
545
*block = YDSC_PNTR->START; /* for the calling program... */
546
*indx = YDSC_PNTR->INDEX - 1;
548
dsctype = YDSC_PNTR->TYPE;
551
goto work_a; /* after that directly to end_of_it ... */
555
else if (action == 'E') /* EXTEND - extend descr. entry */
559
lastlen = YDSC_PNTR->NOELEM; /* save old length */
560
myblock = *block; /* keep starting LDB */
561
myindx = *indx; /* and index out of updates */
563
YDSC_PNTR->NOELEM = *noelem; /* update directory entry for descr. */
564
(void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,0,
565
diroff+found+1,direntry);
567
/* link new extension for existing descr */
569
iret = 2; /* set return pointer -> "extend_1" */
570
goto work_b; /* and do it... */
573
mm1 = *noelem - lastlen; /* length for addition in the end */
574
mm2 = (int) YDSC_PNTR->BYTELEM;
575
dsctype = YDSC_PNTR->TYPE; /* now add space at the end */
580
else if (action == 'D') /* DELETE - delete descr entry in directory */
582
if (strcmp(descr,"DESCRIPTOR.DIRECTORY") == 0)
583
status = ERR_INPINV; /* directory cannot be deleted... */
587
(void) memcpy(dscpntr,dscdir+old_found,(size_t) direntry);
588
YDSC_PNTR->NAMESTR[0]= '\0';
589
(void) MID_WDSCRC(chanl,fcbp->PTRLDB,0,dscpntr,
590
0,old_diroff+old_found+1,direntry);
591
(void) memcpy(dscdir+old_found,dscpntr,(size_t) direntry);
593
if (old_ext == totext)
594
{ /* we deleted in the last extension */
595
diroff = old_diroff; /* point already to last extension */
596
dirfirst = diroff + 1;
597
dirlen = dirused - diroff; /* <= FCB.DIREXT because of `diroff' */
604
while (found < dirlen)
606
if (*cpntrb != '\0') /* check for last filled blocks */
609
cpntrb += direntry; found += direntry;
613
{ /* empty extension! */
619
(void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,dirext,
624
cpntrb = dscdir + mm1 - 1; /* point to last filled block */
625
dirused = dirfirst + mm1 + direntry - 2;
633
else if (action == 'H') /* return help info of last descr. */
635
cpntrb = dscdir + old_found;
636
(void) memcpy(dscpntr,cpntrb,(size_t) direntry); /* -> YDSC entry */
637
*noelem = YDSC_PNTR->HELPLEN;
638
*block = YDSC_PNTR->NAMELEN; /* length of preceding descr name */
643
/* as default we display the contents of the descriptor directory in
644
a user friendly way (`action' = 'Z') */
646
ext = 1; /* extension counter */
647
diroff = 0; /* offset within directory */
648
old_yimno = -1; /* in case, search fails... */
652
dirfirst = diroff + 1;
653
dirlen = dirused - diroff;
654
if (dirext < dirlen) dirlen = dirext;
657
(void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,dirfirst,dirlen,dscdir,&nonul);
660
/* loop through directory extension */
662
(void) snprintf(tmp,(size_t) 80,"Descr_dir_extension %d:",ext);
663
SCTPUT(tmp); /* calling an SC routine is not nice */
664
SCTPUT("-----------------------"); /* but this is a debugging tool only */
669
{ /* get stuff into structure */
670
(void) memcpy(dscpntr,cpntrb,(size_t) direntry);
673
(void) snprintf(tmp,(size_t) 80,"Entry #%d: unused ...",mm1);
676
(void) snprintf(tmp,(size_t) 80,
677
"Entry #%d: Name = %s",mm1,YDSC_PNTR->NAMESTR);
681
(void) snprintf(tmp,(size_t) 80,
682
" Type = %c, No_elem = %d, Bytes_per_elem = %d, unit = %d",
683
YDSC_PNTR->TYPE,YDSC_PNTR->NOELEM,YDSC_PNTR->BYTELEM,YDSC_PNTR->UNIT);
685
(void) snprintf(tmp,(size_t) 80," Start block, Index for data = %d, %d",
686
YDSC_PNTR->START,YDSC_PNTR->INDEX);
688
if (YDSC_PNTR->HELPLEN > 0)
690
cpntra = YDSC_PNTR->NAMESTR+YDSC_PNTR->NAMELEN+1;
691
(void) snprintf(tmp,(size_t) 80,
692
" Help text: %s (%d chars)",cpntra,YDSC_PNTR->HELPLEN);
696
mm1 ++; /* increment dir_entry counter */
697
cpntrb += direntry; nr += direntry;
701
/* check, if we need another segment (next extension) of descr_dir */
705
SCTPUT("Descr. directory:");
706
(void) snprintf(tmp,(size_t) 80,
707
"size = %d, in_use = %d (chars)",diralloc,dirused);
709
(void) snprintf(tmp,(size_t) 80,
710
"no_entries = %d, no_descr = %d (incl. direc)",mm1,mm2);
715
return (ERR_NORMAL); /* we're done */
718
ext ++ ; /* prepare reading of next directory segment */
720
goto dir_search_loop; /* and loop more... */
727
/* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
729
working section for reserving space for a descr
731
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */
734
ext_len = LDB_NDSCRW1; /* index will move from 0 on... */
735
/* read last used LDB */
736
ios = cacheLDB(1,chanl,fcbp->ENDLDB,&ldbp); /* read last used LDB */
737
myindx = (int) fcbp->ENDLDB_OFF - 1; /* remember that arrays begin with 0 */
740
/* determine no. of elements + length in 4-byte words */
742
if ( (dsctype == 'I') || (dsctype == 'R') )
744
else if (dsctype == 'D')
746
n = DD_SIZE / II_SIZE; /* no. of integers in a double */
747
mm1 *= n; /* double prec. looks internally as int */
750
else if (dsctype == 'S')
752
n = SS_SIZE / II_SIZE; /* no. of size_t in a double */
753
mm1 *= n; /* size_t looks internally as int */
756
else /* for type C */
759
long_len = (mm1 + (II_SIZE-1)) / II_SIZE;
762
ldbp->LDBWORDS.IWORD[myindx] = mm1; /* store 1. header lword */
764
if (myindx == ext_len) /* test, if 2. header lword still in same LDB ... */
766
status = MID_CRELDB(entrx,ldbp);
767
if (status != ERR_NORMAL) goto end_of_it;
769
ldbp->LDBWORDS.IWORD[0] = -1; /* currently no extension... */
770
ldbp->LDBWORDS.IWORD[1] = 0; /* index = 0 */
776
ldbp->LDBWORDS.IWORD[myindx] = -1; /* currently no extension... */
777
if (myindx == ext_len) /* see, if 2. header lword in same LDB */
779
status = MID_CRELDB(entrx,ldbp);
780
if (status != ERR_NORMAL) goto end_of_it;
787
ldbp->LDBWORDS.IWORD[myindx] = 0; /* index = 0 */
790
myindx += (long_len + 1) ;
793
while (myindx > ext_len) /* we need more LDBs */
795
status = MID_CRELDB(entrx,ldbp); /* get new LDB + link it in */
796
if (status != ERR_NORMAL) goto end_of_it;
798
myindx -= LDB_NDSCRW;
801
ios = cacheLDB(2,chanl,ldbp->BLKNUM,&ldbp);
803
/* and update FCB (FCB.ENDLDB counts from 1 on) */
805
fcbp->ENDLDB = (unsigned int) ldbp->BLKNUM;
806
fcbp->ENDLDB_OFF = (unsigned int) (myindx + 1);
815
/* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
817
working section for extending + linking descriptors...
819
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */
822
ext_len = LDB_NDSCRW1; /* index will move from 0 on... */
823
ios = cacheLDB(1,chanl,myblock,&ldbp); /* read last used LDB */
827
LDBinfo(chanl,ldbp,myindx,&mm,extens);
828
/* get pointers only */
832
myindx = extens[1] - 1; /* on disk file FORTRAN indexing */
833
if (ldbp->BLKNUM != myblock)
834
ios = cacheLDB(1,chanl,myblock,&ldbp); /* get start LDB of descr. */
838
if (ldbp->BLKNUM != myblock)
839
ios = cacheLDB(1,chanl,myblock,&ldbp); /* get start LDB of descr. */
840
break; /* already get out of loop... */
844
ldbp->LDBWORDS.IWORD[myindx] = mm;
845
if (myindx == ext_len) /* test, if 2. header lword still in same LDB ... */
847
status = MID_CRELDB(entrx,ldbp);
848
if (status != ERR_NORMAL) goto end_of_it;
850
ldbp->LDBWORDS.IWORD[0] = (int) fcbp->ENDLDB; /* store 2. header word */
851
ldbp->LDBWORDS.IWORD[1] = (int) fcbp->ENDLDB_OFF; /* store 3. header word */
856
ldbp->LDBWORDS.IWORD[myindx] = /* store 2. header word */
858
if (myindx == ext_len) /* see, if 3. header word still in same LDB */
860
status = MID_CRELDB(entrx,ldbp);
861
if (status != ERR_NORMAL) goto end_of_it;
868
ldbp->LDBWORDS.IWORD[myindx] = /* store 3. header word */
869
(int) fcbp->ENDLDB_OFF;
872
ios = cacheLDB(2,chanl,ldbp->BLKNUM,&ldbp); /* update LDB */
876
goto extend_1; /* go back to where we came from... */
891
fcbp->DFILLED = dirused;
892
fcbp->DSIZE = diralloc;
896
if (status != ERR_NORMAL)
897
MID_ERROR("MIDAS","MID_YDSCDIR:",status,0);
added
removed
libsrc/st/middsc.c
