/* $Procedure ZZEKTRLK ( EK tree, locate key ) */ /* Subroutine */ int zzektrlk_(integer *handle, integer *tree, integer *key, integer *idx, integer *node, integer *noffst, integer *level, integer *value) { /* Initialized data */ static logical first = TRUE_; /* System generated locals */ integer i__1; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, char *, integer); /* Local variables */ static logical leaf; static integer page[256], prev, unit, plus; extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *); static integer child; extern /* Subroutine */ int chkin_(char *, ftnlen); static integer depth; static logical found; static integer minus; static char access[15]; static integer datbas, oldhan; extern /* Subroutine */ int dasham_(integer *, char *, ftnlen); static integer oldidx, oldmax, oldnod, oldnof, oldtre, oldkey, oldval; extern integer lstlei_(integer *, integer *, integer *); static integer oldlvl, newkey, prvkey, totkey; static logical samkey, samtre, rdonly; extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); /* $ Abstract */ /* Locate a specified key. Return metadata describing the node */ /* containing the key. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Das Paging Parameters */ /* ekpage.inc Version 4 25-AUG-1995 (NJB) */ /* The EK DAS paging system makes use of the integer portion */ /* of an EK file's DAS address space to store the few numbers */ /* required to describe the system's state. The allocation */ /* of DAS integer addresses is shown below. */ /* DAS integer array */ /* +--------------------------------------------+ */ /* | EK architecture code | Address = 1 */ /* +--------------------------------------------+ */ /* | Character page size (in DAS words) | */ /* +--------------------------------------------+ */ /* | Character page base address | */ /* +--------------------------------------------+ */ /* | Number of character pages in file | */ /* +--------------------------------------------+ */ /* | Number of character pages on free list | */ /* +--------------------------------------------+ */ /* | Character free list head pointer | Address = 6 */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for d.p. pages | 7--11 */ /* | | */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for integer pages | 12--16 */ /* | | */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | End Address = */ /* | Unused space | integer page */ /* | | end */ /* +--------------------------------------------+ */ /* | | Start Address = */ /* | First integer page | integer page */ /* | | base */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | */ /* | Last integer page | */ /* | | */ /* +--------------------------------------------+ */ /* The following parameters indicate positions of elements in the */ /* paging system metadata array: */ /* Number of metadata items per data type: */ /* Character metadata indices: */ /* Double precision metadata indices: */ /* Integer metadata indices: */ /* Size of metadata area: */ /* Page sizes, in units of DAS words of the appropriate type: */ /* Default page base addresses: */ /* End Include Section: EK Das Paging Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Tree Parameters */ /* ektree.inc Version 3 22-OCT-1995 (NJB) */ /* The parameters in this file define the tree structure */ /* used by the EK system. This structure is a variant of the */ /* B*-tree structure described in Knuth's book, that is */ /* Knuth, Donald E. "The Art of Computer Programming, */ /* Volume 3/Sorting and Searching" 1973, pp 471-479. */ /* The trees used in the EK system differ from generic B*-trees */ /* primarily in the way keys are treated. Rather than storing */ /* unique primary key values in each node, EK trees store integer */ /* counts that represent the ordinal position of each data value, */ /* counting from the lowest indexed element in the subtree whose */ /* root is the node in question. Thus the keys are unique within */ /* a node but not across multiple nodes: in fact the Nth key in */ /* every leaf node is N. The absolute ordinal position of a data */ /* item is defined recursively as the sum of the key of the data item */ /* and the absolute ordinal position of the data item in the parent */ /* node that immediately precedes all elements of the node in */ /* question. This data structure allows EK trees to support lookup */ /* of data items based on their ordinal position in a data set. The */ /* two prime applications of this capability in the EK system are: */ /* 1) Using trees to index the records in a table, allowing */ /* the Nth record to be located efficiently. */ /* 2) Using trees to implement order vectors that can be */ /* maintained when insertions and deletions are done. */ /* Root node */ /* +--------------------------------------------+ */ /* | Tree version code | */ /* +--------------------------------------------+ */ /* | Number of nodes in tree | */ /* +--------------------------------------------+ */ /* | Number of keys in tree | */ /* +--------------------------------------------+ */ /* | Depth of tree | */ /* +--------------------------------------------+ */ /* | Number of keys in root | */ /* +--------------------------------------------+ */ /* | Space for n keys, | */ /* | | */ /* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ /* | | */ /* | where m is the max number of children per | */ /* | node in the child nodes | */ /* +--------------------------------------------+ */ /* | Space for n+1 child pointers, | */ /* | where n is as defined above. | */ /* +--------------------------------------------+ */ /* | Space for n data pointers, | */ /* | where n is as defined above. | */ /* +--------------------------------------------+ */ /* Child node */ /* +--------------------------------------------+ */ /* | Number of keys present in node | */ /* +--------------------------------------------+ */ /* | Space for m-1 keys | */ /* +--------------------------------------------+ */ /* | Space for m child pointers | */ /* +--------------------------------------------+ */ /* | Space for m-1 data pointers | */ /* +--------------------------------------------+ */ /* The following parameters give the maximum number of children */ /* allowed in the root and child nodes. During insertions, the */ /* number of children may overflow by 1. */ /* Maximum number of children allowed in a child node: */ /* Maximum number of keys allowed in a child node: */ /* Minimum number of children allowed in a child node: */ /* Minimum number of keys allowed in a child node: */ /* Maximum number of children allowed in the root node: */ /* Maximum number of keys allowed in the root node: */ /* Minimum number of children allowed in the root node: */ /* The following parameters indicate positions of elements in the */ /* tree node structures shown above. */ /* The following parameters are for the root node only: */ /* Location of version code: */ /* Version code: */ /* Location of node count: */ /* Location of total key count for the tree: */ /* Location of tree depth: */ /* Location of count of keys in root node: */ /* Base address of keys in the root node: */ /* Base address of child pointers in root node: */ /* Base address of data pointers in the root node (allow room for */ /* overflow): */ /* Size of root node: */ /* The following parameters are for child nodes only: */ /* Location of number of keys in node: */ /* Base address of keys in child nodes: */ /* Base address of child pointers in child nodes: */ /* Base address of data pointers in child nodes (allow room */ /* for overflow): */ /* Size of child node: */ /* A number of EK tree routines must declare stacks of fixed */ /* depth; this depth limit imposes a limit on the maximum depth */ /* that an EK tree can have. Because of the large branching */ /* factor of EK trees, the depth limit is of no practical */ /* importance: The number of keys that can be held in an EK */ /* tree of depth N is */ /* N-1 */ /* MXKIDC - 1 */ /* MXKIDR * ------------- */ /* MXKIDC - 1 */ /* This formula yields a capacity of over 1 billion keys for a */ /* tree of depth 6. */ /* End Include Section: EK Tree Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* TREE I Root of tree. */ /* KEY I Key corresponding to value. */ /* IDX O Node-relative index of KEY. */ /* NODE O Node containing key. */ /* NOFFST O Offset of NODE. */ /* LEVEL O Level of NODE. */ /* VALUE O Value associated with KEY. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* TREE is the root node number of the tree of interest. */ /* KEY is an absolute key. In EK trees, absolute keys are */ /* just ordinal positions relative to the leftmost */ /* element of the tree, with the leftmost element */ /* having position 1. So setting KEY to 10, for */ /* example, indicates that the output VALUE is the */ /* 10th item in the tree. */ /* KEY must be in the range 1 : NKEYS, where */ /* NKEYS is the number of keys in the tree. */ /* $ Detailed_Output */ /* IDX is the node-relative index of KEY: this is the */ /* ordinal position of KEY relative to other keys */ /* in the same node. */ /* NODE is the number of the node containing KEY. */ /* NOFFST is the offset of NODE. This is the count of the */ /* keys that precede every key in the subtree headed */ /* by NODE. Adding NOFFST to any relative key stored */ /* in NODE will convert that key to an absolute key. */ /* LEVEL is the level of NODE in the tree. The root is at */ /* level 1, children of the root are at level 2, and */ /* so on. */ /* VALUE is the integer value associated with the input key. */ /* Normally, this value is a data pointer. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. The file will not be modified. */ /* 2) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* 3) If the input key is out of range, the error */ /* SPICE(INDEXOUTOFRANGE) is signalled. */ /* 4) If the tree traversal fails to terminate at the leaf node */ /* level, the error SPICE(BUG) is signalled. */ /* 5) If the key is in range, but the key is not found, the error */ /* SPICE(BUG) is signalled. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine obtains the value assocated with a key, and also */ /* returns metadata describing the node containing the key and the */ /* key's position in the node. */ /* $ Examples */ /* See ZZEKTRUI. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ /* 3/Sorting and Searching" 1973, pp 471-479. */ /* EK trees are closely related to the B* trees described by */ /* Knuth. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Saved variables */ /* Initial values */ /* Use discovery check-in in this puppy. */ /* Nothing found to begin with. */ found = FALSE_; if (first) { /* Find out the access method for the current file. */ dasham_(handle, access, (ftnlen)15); rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0; samkey = FALSE_; samtre = FALSE_; leaf = FALSE_; first = FALSE_; } else { /* See whether we're looking at the same key, or at least */ /* the same tree, as last time. Note that for the tree to */ /* be guaranteed to be the same, it must belong to a file open */ /* for read access only. */ if (*handle != oldhan) { dasham_(handle, access, (ftnlen)15); rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0; samtre = FALSE_; samkey = FALSE_; } else { samtre = *tree == oldtre && rdonly; samkey = *key == oldkey && samtre; } } /* If we're lucky enough to be getting a request for the previously */ /* returned key, we're set. If we've been asked for a key that is */ /* very close to the previously requested key, we still may make */ /* out pretty well. */ if (samkey) { /* It's the same key as last time. */ *idx = oldidx; *node = oldnod; *noffst = oldnof; *level = oldlvl; *value = oldval; return 0; } else if (samtre && leaf) { /* Compute the margins around the old key. Keys that fall within */ /* the interval defined by the old key and these margins are on */ /* the same page as the old key. */ plus = oldmax - oldidx; minus = oldidx - 1; if (*key <= oldkey + plus && *key >= oldkey - minus) { /* The requested key lies on the same page as the old key. */ *level = oldlvl; if (*level == 1) { datbas = 172; } else { datbas = 128; } *idx = oldidx + (*key - oldkey); *node = oldnod; *noffst = oldnof; *value = page[(i__1 = datbas + *idx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)315)]; oldidx = *idx; oldkey = *key; oldval = *value; return 0; } } /* If we arrived here, we have some actual work to do. */ /* Start out by looking at the root page. Save the tree depth; */ /* we'll use this for error checking. */ zzekpgri_(handle, tree, page); depth = page[3]; *level = 1; /* Find out how many keys are in the tree. If KEY is outside */ /* this range, we won't find it. */ totkey = page[2]; if (*key < 1 || *key > totkey) { chkin_("ZZEKTRLK", (ftnlen)8); dashlu_(handle, &unit); setmsg_("Key = #; valid range = 1:#. Tree = #, file = #", (ftnlen)46); errint_("#", key, (ftnlen)1); errint_("#", &totkey, (ftnlen)1); errint_("#", tree, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); chkout_("ZZEKTRLK", (ftnlen)8); return 0; } /* Find the last key at this level that is less than or equal to */ /* the requested key. */ prev = lstlei_(key, &page[4], &page[5]); if (prev > 0) { prvkey = page[(i__1 = prev + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( "page", i__1, "zzektrlk_", (ftnlen)365)]; } else { prvkey = 0; } /* If we were lucky enough to get an exact match, set our outputs */ /* and return. The key offset in the root is zero. */ if (prvkey == *key) { *noffst = 0; *idx = prev; *node = *tree; *value = page[(i__1 = *idx + 171) < 256 && 0 <= i__1 ? i__1 : s_rnge( "page", i__1, "zzektrlk_", (ftnlen)379)]; oldhan = *handle; oldtre = *tree; oldkey = *key; oldnof = *noffst; oldnod = *node; oldidx = *idx; oldlvl = *level; oldval = *value; oldmax = page[4]; leaf = *level == depth; /* The root has no parent or siblings, so these values */ /* remain set to zero. The same is true of the parent keys. */ return 0; } /* Still here? Traverse the pointer path until we find the key */ /* or run out of progeny. */ child = page[(i__1 = prev + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)405)]; *noffst = prvkey; while(child > 0 && ! found) { /* Look up the child node. */ zzekpgri_(handle, &child, page); ++(*level); if (*level > depth) { chkin_("ZZEKTRLK", (ftnlen)8); dashlu_(handle, &unit); setmsg_("Runaway node pointer chain. Key = #; valid range = 1:#" ". Tree = #, file = #", (ftnlen)75); errint_("#", key, (ftnlen)1); errint_("#", &totkey, (ftnlen)1); errint_("#", tree, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKTRLK", (ftnlen)8); return 0; } /* Find the last key at this level that is less than or equal to */ /* the requested key. Since the keys we're looking at now are */ /* ordinal positions relative to the subtree whose root is the */ /* current node, we must subtract from KEY the position of the */ /* node preceding the first key of this subtree. */ newkey = *key - *noffst; prev = lstlei_(&newkey, page, &page[1]); if (prev > 0) { prvkey = page[(i__1 = prev) < 256 && 0 <= i__1 ? i__1 : s_rnge( "page", i__1, "zzektrlk_", (ftnlen)445)]; } else { prvkey = 0; } /* If we were lucky enough to get an exact match, set our outputs */ /* and return. The key offset for the current node is stored */ /* in NOFFST. */ if (prvkey == newkey) { found = TRUE_; *idx = prev; *node = child; *value = page[(i__1 = *idx + 127) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)460)]; oldhan = *handle; oldtre = *tree; oldkey = *key; oldnof = *noffst; oldnod = *node; oldidx = *idx; oldlvl = *level; oldval = *value; oldmax = page[0]; leaf = *level == depth; } else { child = page[(i__1 = prev + 64) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)476)]; *noffst = prvkey + *noffst; } } /* If we found the key, our outputs are already set. If not, we've */ /* got trouble. */ if (! found) { chkin_("ZZEKTRLK", (ftnlen)8); dashlu_(handle, &unit); setmsg_("Key #; valid range = 1:#. Tree = #, file = #. Key was not " "found. This probably indicates a corrupted file or a bug in" " the EK code.", (ftnlen)132); errint_("#", key, (ftnlen)1); errint_("#", &totkey, (ftnlen)1); errint_("#", tree, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKTRLK", (ftnlen)8); return 0; } return 0; } /* zzektrlk_ */
/* $Procedure DASA2L ( DAS, address to physical location ) */ /* Subroutine */ int dasa2l_(integer *handle, integer *type__, integer * addrss, integer *clbase, integer *clsize, integer *recno, integer * wordno) { /* Initialized data */ static integer next[3] = { 2,3,1 }; static integer prev[3] = { 3,1,2 }; static integer nw[3] = { 1024,128,256 }; static integer rngloc[3] = { 3,5,7 }; static logical first = TRUE_; static integer nfiles = 0; /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer free, nrec, fidx; static logical fast; static integer unit, i__, range[2], tbhan[20]; extern /* Subroutine */ int chkin_(char *, ftnlen); static integer ncomc, ncomr, ndirs; static logical known; static integer hiaddr; extern /* Subroutine */ int dasham_(integer *, char *, ftnlen); static integer tbbase[60] /* was [3][20] */; static char access[10]; static integer dscloc, dirrec[256]; extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *); static logical samfil; static integer mxaddr; extern integer isrchi_(integer *, integer *, integer *); static integer tbmxad[60] /* was [3][20] */; static logical tbfast[20]; static integer mxclrc; extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen); static integer lstrec[3]; extern /* Subroutine */ int sigerr_(char *, ftnlen); static integer prvhan; extern /* Subroutine */ int chkout_(char *, ftnlen); static integer nresvc, tbsize[60] /* was [3][20] */, nxtrec; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), dasrri_(integer *, integer *, integer *, integer *, integer *); static logical rdonly; static integer lstwrd[3], nresvr, ntypes, curtyp, prvtyp; /* $ Abstract */ /* Map a DAS address to a physical location in the DAS file */ /* it refers to. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAS */ /* $ Keywords */ /* DAS */ /* FILES */ /* TRANSFORMATION */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I DAS file handle. */ /* TYPE I Data type specifier. */ /* ADDRSS I DAS address of a word of data type TYPE. */ /* CLBASE, */ /* CLSIZE O Cluster base record number and size. */ /* RECNO, */ /* WORDNO O Record/word pair corresponding to ADDRSS. */ /* CHAR P Parameter indicating character data type. */ /* DP P Parameter indicating double precision data type. */ /* INT P Parameter indicating integer data type. */ /* $ Detailed_Input */ /* HANDLE is the file handle of an open DAS file. */ /* TYPE is a data type specifier. TYPE may be any of */ /* the parameters */ /* CHAR */ /* DP */ /* INT */ /* which indicate `character', `double precision', */ /* and `integer' respectively. */ /* ADDRSS is the address in a DAS of a word of data */ /* type TYPE. For each data type (double precision, */ /* integer, or character), addresses range */ /* from 1 to the maximum current value for that type, */ /* which is available from DAFRFR. */ /* $ Detailed_Output */ /* CLBASE, */ /* CLSIZE are, respectively, the base record number and */ /* size, in records, of the cluster containing the */ /* word corresponding to ADDRSS. The cluster spans */ /* records numbered CLBASE through CLBASE + */ /* CLSIZE - 1. */ /* RECNO, */ /* WORD are, respectively, the number of the physical */ /* record and the number of the word within the */ /* record that correspond to ADDRSS. Word numbers */ /* start at 1 and go up to NC, ND, or NI in */ /* character, double precision, or integer records */ /* respectively. */ /* $ Parameters */ /* CHAR, */ /* DP, */ /* INT are data type specifiers which indicate */ /* `character', `double precision', and `integer' */ /* respectively. These parameters are used in */ /* all DAS routines that require a data type */ /* specifier as input. */ /* $ Exceptions */ /* 1) If TYPE is not recognized, the error SPICE(DASINVALIDTYPE) */ /* will be signalled. */ /* 2) ADDRSS must be between 1 and LAST inclusive, where LAST */ /* is last address in the DAS for a word of the specified */ /* type. If ADDRSS is out of range, the error */ /* SPICE(DASNOSUCHADDRESS) will be signalled. */ /* 3) If this routine fails to find directory information for */ /* the input address, the error SPICE(NOSUCHRECORD) will be */ /* signalled. */ /* 4) If the input handle is invalid, the error will be diagnosed */ /* by routines called by this routine. */ /* If any of the above exceptions occur, the output arguments may */ /* contain bogus information. */ /* $ Files */ /* See the description of the argument HANDLE in $Detailed_Input. */ /* $ Particulars */ /* The DAS architecture allows a programmer to think of the data */ /* within a DAS file as three one-dimensional arrays: one of */ /* double precision numbers, one of integers, and one of characters. */ /* This model allows a programmer to ask the DAS system for the */ /* `nth double precision number (or integer, or character) in the */ /* file'. */ /* DAS files are Fortran direct access files, so to find the */ /* `nth double precision number', you must have the number of the */ /* record containing it and the `word number', or position, within */ /* the record of the double precision number. This routine finds */ /* the record/word number pair that specify the physical location */ /* in a DAS file corresponding to a DAS address. */ /* As opposed to DAFs, the mapping of addresses to physical locations */ /* for a DAS file depends on the organization of data in the file. */ /* Given a fixed set of DAS format parameters, the physical location */ /* of the nth double precision number can depend on how many integer */ /* and character records have been written prior to the record */ /* containing that double precision number. */ /* The cluster information output from this routine allows the */ /* caller to substantially reduce the number of directory reads */ /* required to read a from range of addresses that spans */ /* multiple physical records; the reading program only need call */ /* this routine once per cluster read, rather than once per */ /* physical record read. */ /* $ Examples */ /* 1) Use this routine to read integers from a range of */ /* addresses. This is done in the routine DASRDI. */ /* C */ /* C Decide how many integers to read. */ /* C */ /* NUMINT = LAST - FIRST + 1 */ /* NREAD = 0 */ /* C */ /* C Find out the physical location of the first */ /* C integer. If FIRST is invalid, DASA2L will take care */ /* C of the problem. */ /* C */ /* CALL DASA2L ( HANDLE, INT, FIRST, */ /* . CLBASE, CLSIZE, RECNO, WORDNO ) */ /* C */ /* C Read as much data from record RECNO as necessary. */ /* C */ /* N = MIN ( NUMINT, NWI - WORDNO + 1 ) */ /* CALL DASRRI ( HANDLE, RECNO, WORDNO, WORDNO + N-1, */ /* . DATA ) */ /* NREAD = N */ /* RECNO = RECNO + 1 */ /* C */ /* C Read from as many additional records as necessary. */ /* C */ /* DO WHILE ( NREAD .LT. NUMINT ) */ /* C */ /* C At this point, RECNO is the correct number of the */ /* C record to read from next. CLBASE is the number */ /* C of the first record of the cluster we're about */ /* C to read from. */ /* C */ /* IF ( RECNO .LT. ( CLBASE + CLSIZE ) ) THEN */ /* C */ /* C We can continue reading from the current */ /* C cluster. */ /* C */ /* N = MIN ( NUMINT - NREAD, NWI ) */ /* CALL DASRRI ( HANDLE, */ /* . RECNO, */ /* . 1, */ /* . N, */ /* . DATA ( NREAD + 1 ) ) */ /* NREAD = NREAD + N */ /* RECNO = RECNO + 1 */ /* ELSE */ /* C */ /* C We must find the next integer cluster to */ /* C read from. The first integer in this */ /* C cluster has address FIRST + NREAD. */ /* C */ /* CALL DASA2L ( HANDLE, */ /* . INT, */ /* . FIRST + NREAD, */ /* . CLBASE, */ /* . CLSIZE, */ /* . RECNO, */ /* . WORDNO ) */ /* END IF */ /* END DO */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.1 20-NOV-2001 (NJB) */ /* Comment fix: diagram showing directory record pointers */ /* incorrectly showed element 2 of the record as a backward */ /* pointer. The element is actually a forward pointer. */ /* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */ /* Bug fix: calculation to determine whether file is segregated */ /* has been fixed. */ /* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ /* Corrected title of permuted index entry section. */ /* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ /* Re-written to optimize address calculations for segregated, */ /* read-only files. */ /* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ /* Fixed a typo in the $ Brief_I/O section of the header. */ /* Removed references to specific DAS file open routines in the */ /* $ Detailed_Input section of the header. This was done in order */ /* to minimize documentation changes if the DAS open routines ever */ /* change. */ /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* map DAS logical address to physical location */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */ /* Bug fix: calculation to determine whether file is segregated */ /* has been fixed. An incorrect variable name used in a bound */ /* calculation resulted in an incorrect determination of whether */ /* a file was segregated, and caused arithmetic overflow for */ /* files with large maximum addresses. */ /* In the previous version, the number of DAS words in a cluster */ /* was incorrectly calculated as the product of the maximum */ /* address of the cluster's data type and the number of words of */ /* that data type in a DAS record. The correct product involves */ /* the number of records in the cluster and the number of words of */ /* that data type in a DAS record. */ /* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ /* Re-written to optimize address calculations for segregated, */ /* read-only files. */ /* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ /* Fixed a typo in the $ Brief_I/O section of the header. */ /* Removed references to specific DAS file open routines in the */ /* $ Detailed_Input section of the header. This was done in order */ /* to minimize documentation changes if the DAS open routines ever */ /* change. */ /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Words per data record, for each data type: */ /* Directory pointer locations */ /* Directory address range locations */ /* Indices of lowest and highest addresses in a `range array': */ /* Location of first type descriptor */ /* Access word length */ /* File table size */ /* Local variables */ /* Saved variables */ /* Initial values */ /* NEXT and PREV map the DAS data type codes to their */ /* successors and predecessors, respectively. */ /* Discovery check-in is used in this routine. */ /* DAS files have the following general structure: */ /* +------------------------+ */ /* | file record | */ /* +------------------------+ */ /* | reserved records | */ /* | | */ /* +------------------------+ */ /* | comment records | */ /* | | */ /* | | */ /* | | */ /* +------------------------+ */ /* | first data directory | */ /* +------------------------+ */ /* | data records | */ /* | | */ /* | | */ /* | | */ /* | | */ /* +------------------------+ */ /* . */ /* . */ /* +------------------------+ */ /* | last data directory | */ /* +------------------------+ */ /* | data records | */ /* | | */ /* | | */ /* +------------------------+ */ /* Within each DAS data record, word numbers start at one and */ /* increase up to NWI, NWD, or NWC: the number of words in an */ /* integer, double precision, or character data record. */ /* +--------------------------------+ */ /* | | | ... | | */ /* +--------------------------------+ */ /* 1 2 NWD */ /* +--------------------------------+ */ /* | | | ... | | */ /* +--------------------------------+ */ /* 1 2 NWI */ /* +------------------------------------+ */ /* | | | ... | | */ /* +------------------------------------+ */ /* 1 2 NWC */ /* Directories are single records that describe the data */ /* types of data records that follow. The directories */ /* in a DAS file form a doubly linked list: each directory */ /* contains forward and backward pointers to the next and */ /* previous directories. */ /* Each directory also contains, for each data type, the lowest */ /* and highest logical address occurring in any of the records */ /* described by the directory. */ /* Following the pointers and address range information is */ /* a sequence of data type descriptors. These descriptors */ /* indicate the data type of data records following the */ /* directory record. Each descriptor gives the data type */ /* of a maximal set of contiguous data records, all having the */ /* same type. By `maximal set' we mean that no data records of */ /* the same type bound the set of records in question. */ /* Pictorially, the structure of a directory is as follows: */ /* +----------------------------------------------------+ */ /* | <pointers> | <address ranges> | <type descriptors> | */ /* +----------------------------------------------------+ */ /* where the <pointers> section looks like */ /* +-----------------------------------------+ */ /* | <backward pointer> | <forward pointer> | */ /* +-----------------------------------------+ */ /* the <address ranges> section looks like */ /* +-------------------------------------------+ */ /* | <char range> | <d.p. range> | <int range> | */ /* +-------------------------------------------+ */ /* and each range looks like one of: */ /* +------------------------------------------------+ */ /* | <lowest char address> | <highest char address> | */ /* +------------------------------------------------+ */ /* +------------------------------------------------+ */ /* | <lowest d.p. address> | <highest d.p. address> | */ /* +------------------------------------------------+ */ /* +------------------------------------------------+ */ /* | <lowest int address> | <highest int address> | */ /* +------------------------------------------------+ */ /* The type descriptors implement a run-length encoding */ /* scheme. The first element of the series of descriptors */ /* occupies two integers: it contains a type code and a count. */ /* The rest of the descriptors are just signed counts; the data */ /* types of the records they describe are deduced from the sign */ /* of the count and the data type of the previous descriptor. */ /* The method of finding the data type for a given descriptor */ /* in terms of its predecessor is as follows: if the sign of a */ /* descriptor is positive, the type of that descriptor is the */ /* successor of the type of the preceding descriptor in the */ /* sequence of types below. If the sign of a descriptor is */ /* negative, the type of the descriptor is the predecessor of the */ /* type of the preceding descriptor. */ /* C --> D --> I --> C */ /* For example, if the preceding type is `I', and a descriptor */ /* contains the number 16, the type of the descriptor is `C', */ /* whereas if the descriptor contained the number -800, the type */ /* of the descriptor would be `D'. */ /* Make sure the data type is valid. */ if (*type__ < 1 || *type__ > 3) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Invalid data type: #. File was #", (ftnlen)33); errint_("#", type__, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASINVALIDTYPE)", (ftnlen)21); chkout_("DASA2L", (ftnlen)6); return 0; } /* Decide whether we're looking at the same file as we did on */ /* the last call. */ if (first) { samfil = FALSE_; fast = FALSE_; prvhan = *handle; first = FALSE_; } else { samfil = *handle == prvhan; prvhan = *handle; } /* We have a special case if we're looking at a `fast' file */ /* that we saw on the last call. When we say a file is fast, */ /* we're implying that it's open for read access only and that it's */ /* segregated. In this case, we can do an address calculation */ /* without looking up any information from the file. */ if (samfil && fast) { *clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2l_", (ftnlen)666)]; *clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)667)]; mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)668)]; hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)669)]; /* Make sure that ADDRSS points to an existing location. */ if (*addrss < 1 || *addrss > mxaddr) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("ADDRSS was #; valid range for type # is # to #. File w" "as #", (ftnlen)59); errint_("#", addrss, (ftnlen)1); errint_("#", type__, (ftnlen)1); errint_("#", &c__1, (ftnlen)1); errint_("#", &mxaddr, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); chkout_("DASA2L", (ftnlen)6); return 0; } } else { /* If the current file is not the same one we looked at on the */ /* last call, find out whether the file is on record in our file */ /* table. Add the file to the table if necessary. Bump the */ /* oldest file in the table if there's no room. */ if (! samfil) { fidx = isrchi_(handle, &nfiles, tbhan); known = fidx > 0; if (known) { /* The file is in our list. */ fast = tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbfast", i__1, "dasa2l_", (ftnlen)708)]; if (fast) { /* This is a segregated, read-only file. Look up the */ /* saved information we'll need to calculate addresses. */ *clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2" "l_", (ftnlen)715)]; *clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2" "l_", (ftnlen)716)]; mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)717)]; hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", ( ftnlen)718)]; /* Make sure that ADDRSS points to an existing location. */ if (*addrss < 1 || *addrss > mxaddr) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("ADDRSS was #; valid range for type # is # " "to #. File was #", (ftnlen)60); errint_("#", addrss, (ftnlen)1); errint_("#", type__, (ftnlen)1); errint_("#", &c__1, (ftnlen)1); errint_("#", &mxaddr, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); chkout_("DASA2L", (ftnlen)6); return 0; } } /* FAST is set. */ } /* KNOWN is set. */ } /* SAMFIL, FAST, and KNOWN are set. If the file is the same one */ /* we saw on the last call, the state variables FAST, and KNOWN */ /* retain their values from the previous call. */ /* FIDX is set at this point only if we're looking at a known */ /* file. */ /* Unless the file is recognized and known to be a fast file, we */ /* look up all metadata for the file. */ if (! (known && fast)) { if (! known) { /* This file is not in our list. If the list is not full, */ /* append the file to the list. If the list is full, */ /* replace the oldest (first) file with this one. */ if (nfiles < 20) { ++nfiles; fidx = nfiles; } else { fidx = 1; } tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "tbhan", i__1, "dasa2l_", (ftnlen)781)] = *handle; /* Find out whether the file is open for read or write */ /* access. We consider the file to be `slow' until we find */ /* out otherwise. The contents of the arrays TBHIGH, */ /* TBBASE, TBSIZE, and TBMXAD are left undefined for slow */ /* files. */ dasham_(handle, access, (ftnlen)10); rdonly = s_cmp(access, "READ", (ftnlen)10, (ftnlen)4) == 0; fast = FALSE_; tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "tbfast", i__1, "dasa2l_", (ftnlen)794)] = fast; /* We'll set the flag KNOWN at the end of the outer IF */ /* block. */ } else { /* We set RDONLY to .FALSE. for any known file that is */ /* not fast. It's actually possible for a read-only file */ /* to be unsegregated, but this is expected to be a rare */ /* case, one that's not worth complicating this routine */ /* further for. */ rdonly = FALSE_; } /* RDONLY is set. */ /* FIDX is now set whether or not the current file is known. */ /* Get the number of reserved records, comment records, and */ /* the current last address of the data type TYPE from the */ /* file summary. */ dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, &tbmxad[( i__1 = fidx * 3 - 3) < 60 && 0 <= i__1 ? i__1 : s_rnge( "tbmxad", i__1, "dasa2l_", (ftnlen)821)], lstrec, lstwrd); mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)831)]; /* Make sure that ADDRSS points to an existing location. */ if (*addrss < 1 || *addrss > mxaddr) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("ADDRSS was #; valid range for type # is # to #. F" "ile was #", (ftnlen)60); errint_("#", addrss, (ftnlen)1); errint_("#", type__, (ftnlen)1); errint_("#", &c__1, (ftnlen)1); errint_("#", &mxaddr, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); chkout_("DASA2L", (ftnlen)6); return 0; } /* Find out which directory describes the cluster containing */ /* this word. To do this, we must traverse the directory */ /* list. The first directory record comes right after the */ /* last comment record. (Don't forget the file record when */ /* counting the predecessors of the directory record.) */ /* Note that we don't need to worry about not finding a */ /* directory record that contains the address we're looking */ /* for, since we've already checked that the address is in */ /* range. */ /* Keep track of the number of directory records we see. We'll */ /* use this later to determine whether we've got a segregated */ /* file. */ nrec = nresvr + ncomr + 2; ndirs = 1; i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)872)] + 1; dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen) 872)], &i__3, range); while(range[1] < *addrss) { /* The record number of the next directory is the forward */ /* pointer in the current directory record. Update NREC */ /* with this pointer. Get the address range for the */ /* specified type covered by this next directory record. */ dasrri_(handle, &nrec, &c__2, &c__2, &nxtrec); nrec = nxtrec; ++ndirs; i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)891)] + 1; dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", ( ftnlen)891)], &i__3, range); } /* NREC is now the record number of the directory that contains */ /* the type descriptor for the address we're looking for. */ /* Our next task is to find the descriptor for the cluster */ /* containing the input address. To do this, we must examine */ /* the directory record in `left-to-right' order. As we do so, */ /* we'll keep track of the highest address of type TYPE */ /* occurring in the clusters whose descriptors we've seen. */ /* The variable HIADDR will contain this address. */ dasrri_(handle, &nrec, &c__1, &c__256, dirrec); /* In the process of finding the physical location */ /* corresponding to ADDRSS, we'll find the record number of the */ /* base of the cluster containing ADDRSS. We'll start out by */ /* initializing this value with the number of the first data */ /* record of the next cluster. */ *clbase = nrec + 1; /* We'll initialize HIADDR with the value preceding the lowest */ /* address of type TYPE described by the current directory. */ hiaddr = dirrec[(i__2 = rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen) 925)] - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", (ftnlen)925)] - 1; /* Initialize the number of records described by the last seen */ /* type descriptor. This number, when added to CLBASE, should */ /* yield the number of the first record of the current cluster; */ /* that's why it's initialized to 0. */ *clsize = 0; /* Now find the descriptor for the cluster containing ADDRSS. */ /* Read descriptors until we get to the one that describes the */ /* record containing ADDRSS. Keep track of descriptor data */ /* types as we go. Also count the descriptors. */ /* At this point, HIADDR is less than ADDRSS, so the loop will */ /* always be executed at least once. */ prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen)944)]; dscloc = 10; while(hiaddr < *addrss) { /* Update CLBASE so that it is the record number of the */ /* first record of the current cluster. */ *clbase += *clsize; /* Find the type of the current descriptor. */ if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", (ftnlen)957)] > 0) { curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("next", i__1, "dasa2l_", (ftnlen)958)]; } else { curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen)960)]; } /* Forgetting to update PRVTYP is a Very Bad Thing (VBT). */ prvtyp = curtyp; /* If the current descriptor is of the type we're interested */ /* in, update the highest address count. */ if (curtyp == *type__) { hiaddr += nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)973)] * ( i__3 = dirrec[(i__2 = dscloc - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", ( ftnlen)973)], abs(i__3)); } /* Compute the number of records described by the current */ /* descriptor. Update the descriptor location. */ *clsize = (i__2 = dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", ( ftnlen)980)], abs(i__2)); ++dscloc; } /* If we have an unknown read-only file, see whether the file */ /* is segregated. If it is, we'll be able to compute */ /* addresses much faster for subsequent reads to this file. */ if (rdonly && ! known) { if (ndirs == 1) { /* If this file is segregated, there are at most three */ /* cluster descriptors, and each one points to a cluster */ /* containing all records of the corresponding data type. */ /* For each data type having a non-zero maximum address, */ /* the size of the corresponding cluster must be large */ /* enough to hold all addresses of that type. */ ntypes = 0; for (i__ = 1; i__ <= 3; ++i__) { if (tbmxad[(i__1 = i__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_" , (ftnlen)1005)] > 0) { ++ntypes; } } /* Now look at the first NTYPES cluster descriptors, */ /* collecting cluster bases and sizes as we go. */ mxclrc = nrec + 1; prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen) 1016)]; dscloc = 10; fast = TRUE_; while(dscloc <= ntypes + 9 && fast) { /* Find the type of the current descriptor. */ if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", ( ftnlen)1025)] > 0) { curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("next", i__1, "dasa" "2l_", (ftnlen)1026)]; } else { curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa" "2l_", (ftnlen)1028)]; } prvtyp = curtyp; tbbase[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2l_" , (ftnlen)1032)] = mxclrc; tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_" , (ftnlen)1033)] = (i__3 = dirrec[(i__2 = dscloc - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", (ftnlen) 1033)], abs(i__3)); mxclrc += tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)1034)]; fast = tbmxad[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)1037)] <= tbsize[(i__2 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__2 ? i__2 : s_rnge("tbsize", i__2, "dasa2l_", ( ftnlen)1037)] * nw[(i__3 = curtyp - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("nw", i__3, "dasa2" "l_", (ftnlen)1037)]; ++dscloc; } /* FAST is set. */ } else { /* The file has more than one directory record. */ fast = FALSE_; } /* If the file was unknown, readonly, and had one directory */ /* record, we determined whether it was a fast file. */ } else { /* The file was already known and wasn't fast, or is not */ /* readonly. */ fast = FALSE_; } /* FAST is set. */ } /* This is the end of the `.NOT. ( KNOWN .AND. FAST )' case. */ /* At this point, we've set or looked up CLBASE, CLSIZE, MXADDR, */ /* and HIADDR. */ /* If the file was unknown, we set TBHAN, TBRDON, and TBFAST. */ /* If the file was unknown and turned out to be fast, we set */ /* TBBASE, TBSIZE, TBHIGH, and TBMXAD as well. */ /* At this point, it's safe to indicate that the file is known. */ known = TRUE_; } /* At this point, */ /* -- CLBASE is properly set: it is the record number of the */ /* first record of the cluster containing ADDRSS. */ /* -- CLSIZE is properly set: it is the size of the cluster */ /* containing ADDRSS. */ /* -- HIADDR is the last logical address in the cluster */ /* containing ADDRSS. */ /* Now we must find the physical record and word corresponding */ /* to ADDRSS. The structure of the cluster containing ADDRSS and */ /* HIADDR is shown below: */ /* +--------------------------------------+ */ /* | | Record # CLBASE */ /* +--------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------+ */ /* | |ADDRSS| | Record # RECNO */ /* +--------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------+ Record # */ /* | |HIADDR| */ /* +--------------------------------------+ CLBASE + CLSIZE - 1 */ *recno = *clbase + *clsize - 1 - (hiaddr - *addrss) / nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", ( ftnlen)1122)]; *wordno = *addrss - (*addrss - 1) / nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)1125)] * nw[( i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("nw", i__2, "dasa2l_", (ftnlen)1125)]; return 0; } /* dasa2l_ */