/* $Procedure EKINSR ( EK, insert record into segment ) */ /* Subroutine */ int ekinsr_(integer *handle, integer *segno, integer *recno) { /* System generated locals */ integer i__1, i__2, i__3; /* Local variables */ integer base, nrec, size, room; extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), zzekrbck_(char *, integer *, integer *, integer *, integer *, ftnlen), zzekmloc_(integer *, integer *, integer *, integer *), zzekpgbs_(integer *, integer *, integer *), zzektrin_(integer *, integer *, integer *, integer *); integer p, mbase; extern /* Subroutine */ int chkin_(char *, ftnlen), filli_(integer *, integer *, integer *); integer ncols, lastp, lastw; extern logical failed_(void); integer coldsc[11], mp; extern logical return_(void); integer nlinks, recbas, recptr[254], segdsc[24]; logical isshad; extern /* Subroutine */ int chkout_(char *, ftnlen), dasrdi_(integer *, integer *, integer *, integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), cleari_(integer *, integer *), ekshdw_(integer *, logical *), dasudi_(integer *, integer *, integer *, integer *), zzekaps_( integer *, integer *, integer *, logical *, integer *, integer *); /* $ Abstract */ /* Add a new, empty record to a specified E-kernel segment at */ /* a specified index. */ /* $ 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 */ /* PRIVATE */ /* UTILITY */ /* $ 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 Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor 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 Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page 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 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 Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer 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 Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor 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. */ /* SEGNO I Segment number. */ /* RECNO I Record number. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* SEGNO is the number of the segment to which the record */ /* is to be added. */ /* RECNO is the index of the new record. RECNO must be */ /* in the range 1 : (NREC+1), where NREC is the */ /* number of records in the segment prior to the */ /* insertion. If RECNO is equal to NREC+1, the */ /* new record is appended. Otherwise, the new */ /* record has the ordinal position specified by */ /* RECNO, and the records previously occupying */ /* positions RECNO : NREC have their indexes */ /* incremented by 1. */ /* $ Detailed_Output */ /* None. See the $Particulars section for a description of the */ /* effect of this routine. */ /* $ 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 SEGNO is out of range, the error SPICE(INVALIDINDEX) */ /* will be signalled. The file will not be modified. */ /* 3) If RECNO is out of range, the error SPICE(INVALIDINDEX) */ /* will be signalled. The file will not be modified. */ /* 4) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. The file may be corrupted. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: It adds a new, empty */ /* record structure to an EK segment at a specified ordinal position. */ /* After a record has been inserted into a segment by this routine, */ /* the record must be populated with data using the EKACEx */ /* routines. EKs are valid only when all of their column entries */ /* are initialized. */ /* To append a record to a segment, use the routine EKAPPR. */ /* This routine cannot be used with the "fast write" suite of */ /* routines. See the EK Required Reading for a discussion of the */ /* fast writers. */ /* When a record is inserted into an EK file that is not shadowed, */ /* the status of the record starts out set to OLD. The status */ /* does not change when data is added to the record. */ /* If the target EK is shadowed, the new record will be given the */ /* status NEW. Updating column values in the record does not change */ /* its status. When changes are committed, the status is set to OLD. */ /* If a rollback is performed before changes are committed, the */ /* record is deleted. Closing the target file without committing */ /* changes implies a rollback. */ /* $ Examples */ /* 1) Insert a record into a specified E-kernel segment at a */ /* specified ordinal position. */ /* Suppose we have an E-kernel named ORDER_DB.EK which contains */ /* records of orders for data products. The E-kernel has a */ /* table called DATAORDERS that consists of the set of columns */ /* listed below: */ /* DATAORDERS */ /* Column Name Data Type */ /* ----------- --------- */ /* ORDER_ID INTEGER */ /* CUSTOMER_ID INTEGER */ /* LAST_NAME CHARACTER*(*) */ /* FIRST_NAME CHARACTER*(*) */ /* ORDER_DATE TIME */ /* COST DOUBLE PRECISION */ /* The order database also has a table of items that have been */ /* ordered. The columns of this table are shown below: */ /* DATAITEMS */ /* Column Name Data Type */ /* ----------- --------- */ /* ITEM_ID INTEGER */ /* ORDER_ID INTEGER */ /* ITEM_NAME CHARACTER*(*) */ /* DESCRIPTION CHARACTER*(*) */ /* PRICE DOUBLE PRECISION */ /* We'll suppose that the file ORDER_DB.EK contains two segments, */ /* the first containing the DATAORDERS table and the second */ /* containing the DATAITEMS table. */ /* If we wanted to insert a new record into the DATAORDERS */ /* table in position 1, we'd make the following calls: */ /* C */ /* C Open the database for write access. */ /* C */ /* CALL EKOPW ( 'ORDER_DB.EK', HANDLE ) */ /* C */ /* C Insert a new, empty record into the DATAORDERS */ /* C table at record number 1. This moves the existing */ /* C records down, so the old record 1 becomes record 2, */ /* C and so on. Recall that the DATAORDERS table */ /* C is in segment number 1. */ /* C */ /* RECNO = 1 */ /* SEGNO = 1 */ /* CALL EKINSR ( HANDLE, SEGNO, RECNO ) */ /* C */ /* C At this point, the new record is empty. A valid EK */ /* C cannot contain empty records. We fill in the data */ /* C here. Data items are filled in one column at a time. */ /* C The order in which the columns are filled in is not */ /* C important. We use the EKACEx (add column entry) */ /* C routines to fill in column entries. We'll assume */ /* C that no entries are null. All entries are scalar, */ /* C so the entry size is 1. */ /* C */ /* ISNULL = .FALSE. */ /* ESIZE = 1 */ /* C */ /* C The following variables will contain the data for */ /* C the new record. */ /* C */ /* ORDID = 10011 */ /* CUSTID = 531 */ /* LNAME = 'Scientist' */ /* FNAME = 'Joe' */ /* ODATE = '1995-SEP-20' */ /* COST = 0.D0 */ /* C */ /* C Note that the names of the routines called */ /* C correspond to the data types of the columns: the */ /* C last letter of the routine name is C, I, or D, */ /* C depending on the data type. Time values are */ /* C converted to ET for storage. */ /* C */ /* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'ORDER_ID', */ /* . SIZE, ORDID, ISNULL ) */ /* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'CUSTOMER_ID', */ /* . SIZE, CUSTID, ISNULL ) */ /* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'LAST_NAME', */ /* . SIZE, LNAME, ISNULL ) */ /* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'FIRST_NAME', */ /* . SIZE, FNAME, ISNULL ) */ /* CALL UTC2ET ( ODATE, ET ) */ /* CALL EKACED ( HANDLE, SEGNO, RECNO, 'ORDER_DATE', */ /* . SIZE, ET, ISNULL ) */ /* CALL EKACED ( HANDLE, SEGNO, RECNO, 'COST', */ /* . SIZE, COST, ISNULL ) */ /* C */ /* C Close the file to make the update permanent. */ /* C */ /* CALL EKCLS ( HANDLE ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */ /* Documentation change: instances of the phrase "fast load" */ /* were replaced with "fast write." */ /* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */ /* -& */ /* $ Index_Entries */ /* insert record into EK segment */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("EKINSR", (ftnlen)6); } /* Before trying to actually write anything, do every error */ /* check we can. */ /* Is this file handle valid--is the file open for paged write */ /* access? Signal an error if not. */ zzekpgch_(handle, "WRITE", (ftnlen)5); if (failed_()) { chkout_("EKINSR", (ftnlen)6); return 0; } /* Look up the integer metadata page and page base for the segment. */ /* Given the base address, we can read the pertinent metadata in */ /* one shot. */ zzekmloc_(handle, segno, &mp, &mbase); if (failed_()) { chkout_("EKINSR", (ftnlen)6); return 0; } i__1 = mbase + 1; i__2 = mbase + 24; dasrdi_(handle, &i__1, &i__2, segdsc); /* We'll need to know how many columns the segment has in order to */ /* compute the size of the record pointer. The record pointer */ /* contains DPTBAS items plus two elements for each column. */ ncols = segdsc[4]; size = ncols + 2; /* We're assuming the record pointer can fit on an integer page. */ /* If this is not the case, we've got a bug. */ if (size > 254) { setmsg_("Record pointer requires # integer words; EK software assume" "s size is <= #. This is an EK software bug. Contact NAIF.", (ftnlen)118); errint_("#", &size, (ftnlen)1); errint_("#", &c__254, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("EKINSR", (ftnlen)6); return 0; } /* Check the number of records already present. RECNO must not */ /* exceed this count by more than 1. */ nrec = segdsc[5]; if (*recno < 1 || *recno > nrec + 1) { setmsg_("Record number = #; valid range is 1:#.", (ftnlen)38); errint_("#", recno, (ftnlen)1); i__1 = nrec + 1; errint_("#", &i__1, (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("EKINSR", (ftnlen)6); return 0; } /* Find the last integer data page and the last word in use in that */ /* page. If there's enough room, we can store the record pointer */ /* in the current page. */ lastp = segdsc[17]; lastw = segdsc[20]; room = 254 - lastw; /* Initialize the record pointer: set the record's status and */ /* set the data pointers to indicate no data is present. To */ /* determine the status, we must know whether the parent file is */ /* shadowed. */ cleari_(&c__254, recptr); filli_(&c_n1, &c__252, recptr); ekshdw_(handle, &isshad); if (isshad) { recptr[0] = 3; } else { recptr[0] = 1; } /* Find a place to write the record pointer. */ if (size <= room) { /* Just write the record pointer into the current integer page. */ zzekpgbs_(&c__3, &lastp, &base); recbas = base + lastw; i__1 = recbas + 1; i__2 = recbas + size; dasudi_(handle, &i__1, &i__2, recptr); /* Update the page's metadata to reflect the addition. The */ /* page gains a link. */ i__1 = base + 256; i__2 = base + 256; dasrdi_(handle, &i__1, &i__2, &nlinks); i__1 = base + 256; i__2 = base + 256; i__3 = nlinks + 1; dasudi_(handle, &i__1, &i__2, &i__3); /* The last integer word in use has changed too. */ segdsc[20] += size; } else { /* Allocate an integer page. */ zzekaps_(handle, segdsc, &c__3, &c_false, &p, &recbas); /* Write out the record pointer. */ i__1 = recbas + 1; i__2 = recbas + size; dasudi_(handle, &i__1, &i__2, recptr); /* Update the page's metadata to reflect the addition. The */ /* page starts out with one link. */ i__1 = recbas + 256; i__2 = recbas + 256; dasudi_(handle, &i__1, &i__2, &c__1); /* Update the segment's metadata to reflect the addition of a */ /* data page. The last page in use is the one we just wrote to. */ /* The last word in use is the last word of the record pointer. */ segdsc[17] = p; segdsc[20] = size; } /* Update the segment's metadata to reflect the addition of the */ /* new record. The base address of the record is inserted into */ /* the data record tree at index RECNO. The record count gets */ /* incremented. */ zzektrin_(handle, &segdsc[6], recno, &recbas); ++segdsc[5]; /* If the segment is shadowed but no backup segment exists yet, we */ /* need to create one. We'll let ZZEKRBCK take care of the details. */ /* Note that for data additions, the input argument COLDSC is */ /* ignored. */ zzekrbck_("ADD", handle, segdsc, coldsc, recno, (ftnlen)3); /* Write out the updated segment descriptor. */ i__1 = mbase + 1; i__2 = mbase + 24; dasudi_(handle, &i__1, &i__2, segdsc); chkout_("EKINSR", (ftnlen)6); return 0; } /* ekinsr_ */
/* $Procedure DASSDR ( DAS, segregate data records ) */ /* Subroutine */ int dassdr_(integer *handle) { /* Initialized data */ static integer next[3] = { 2,3,1 }; static integer prev[3] = { 3,1,2 }; /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ integer base; char crec[1024]; doublereal drec[128]; integer free, irec[256], lrec, dest; logical more; integer unit, type__, i__, j, n; extern /* Subroutine */ int chkin_(char *, ftnlen); integer ncomc; extern /* Subroutine */ int maxai_(integer *, integer *, integer *, integer *); char savec[1024]; doublereal saved[128]; integer recno, savei[256]; extern integer sumai_(integer *, integer *); integer ncomr, total, lword, count[4], ltype, start; extern logical failed_(void); extern /* Subroutine */ int dasadi_(integer *, integer *, integer *), cleari_(integer *, integer *); integer drbase; extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *, ftnlen, ftnlen), dasiod_(char *, integer *, integer *, doublereal *, ftnlen), dasllc_(integer *), dasrdi_(integer *, integer *, integer *, integer *), dashfs_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *), dasudi_(integer *, integer *, integer *, integer *); integer minadr, maxadr, scrhan, lastla[3]; extern /* Subroutine */ int dassih_(integer *, char *, ftnlen), dashlu_( integer *, integer *), daswbr_(integer *), dasrri_(integer *, integer *, integer *, integer *, integer *); integer offset; extern /* Subroutine */ int dasioi_(char *, integer *, integer *, integer *, ftnlen); integer lastrc[3]; extern /* Subroutine */ int dasops_(integer *), dasufs_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *), chkout_(char *, ftnlen); integer lastwd[3], nresvc; extern logical return_(void); integer nresvr, savtyp, prvtyp, loc, pos; /* $ Abstract */ /* Segregate the data records in a DAS file into clusters, using */ /* one cluster per data type present in the file. */ /* $ 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 */ /* ORDER */ /* SORT */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I DAS file handle. */ /* $ Detailed_Input */ /* HANDLE is a file handle of a DAS file opened for writing. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the input file handle is invalid, the error will be */ /* diagnosed by routines called by this routine. */ /* 2) If a Fortran read attempted by this routine fails, the */ /* error will be diagnosed by routines called by this routine. */ /* The state of the DAS file undergoing re-ordering will be */ /* indeterminate. */ /* 3) If a Fortran write attempted by this routine fails, the */ /* error will be diagnosed by routines called by this routine. */ /* The state of the DAS file undergoing re-ordering will be */ /* indeterminate. */ /* 4) If any other I/O error occurs during the re-arrangement of */ /* the records in the indicated DAS file, the error will be */ /* diagnosed by routines called by this routine. */ /* $ Files */ /* See the description of the argument HANDLE in $Detailed_Input. */ /* $ Particulars */ /* Normally, there should be no need for routines outside of */ /* SPICELIB to call this routine. */ /* The effect of this routine is to re-arrange the data records */ /* in a DAS file so that the file contains a single cluster for */ /* each data type present in the file: in the general case, there */ /* will be a single cluster of each of the integer, double */ /* precision, and character data types. */ /* The relative order of data records of a given type is not */ /* affected by this re-ordering. After the re-ordering, the DAS */ /* file contains a single directory record that has one descriptor */ /* for each cluster. After that point, the order in the file of the */ /* sets of data records of the various data types will be: */ /* +-------+ */ /* | CHAR | */ /* +-------+ */ /* | DP | */ /* +-------+ */ /* | INT | */ /* +-------+ */ /* Files that contain multiple directory records will have all but */ /* the first directory record moved to the end of the file when the */ /* re-ordering is complete. These records are not visible to the */ /* DAS system and will be overwritten if data is subsequently added */ /* to the DAS file. */ /* The purpose of segregating a DAS file's data records into three */ /* clusters is to make read access more efficient: when a DAS file */ /* contains a single directory with at most three cluster type */ /* descriptors, mapping logical to physical addresses can be done */ /* in constant time. */ /* $ Examples */ /* 1) Segregate data records in a DAS file designated by */ /* HANDLE: */ /* CALL DASSDR ( HANDLE ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.1 19-DEC-1995 (NJB) */ /* Corrected title of permuted index entry section. */ /* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */ /* Added test of FAILED after each DAS call, or sequence of calls, */ /* which returns immediately if FAILED is true. This fixes a bug */ /* where DASOPS signals an error and then DASSDR has a */ /* segmentation fault. */ /* 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. */ /* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */ /* Bug fix: call to CLEARD replaced with call to */ /* CLEARI. */ /* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) (MJS) */ /* Bug fix: extraneous commas removed from argument lists */ /* in calls to DASADI. */ /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* segregate the data records in a DAS file */ /* -& */ /* $ Revisions */ /* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */ /* Added test of failed after each DAS call, or sequence of calls, */ /* which returns immediately if FAILED is true. This fixes a bug */ /* where DASOPS signals an error and then DASSDR has a */ /* segmentation fault. */ /* 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. */ /* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */ /* Bug fix: call to CLEARD replaced with call to */ /* CLEARI. */ /* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) */ /* Bug fix: extraneous commas removed from argument lists */ /* in calls to DASADI. This bug had no visible effect on */ /* VAX and Sun systems, but generated a compile error under */ /* Lahey Fortran. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Data type parameters */ /* Directory pointer locations (backward and forward): */ /* Directory address range location base */ /* Location of first type descriptor */ /* Local variables */ /* Saved variables */ /* NEXT and PREV map the DAS data type codes to their */ /* successors and predecessors, respectively. */ /* Initial values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("DASSDR", (ftnlen)6); } /* Before starting, make sure that this DAS file is open for */ /* writing. */ dassih_(handle, "WRITE", (ftnlen)5); /* Get the logical unit for this file. */ dashlu_(handle, &unit); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Write out any buffered records that belong to the file. */ daswbr_(handle); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* We're going to re-order the physical records in the DAS file, */ /* starting with the first record after the first directory. */ /* The other directory records are moved to the end of the file */ /* as a result of the re-ordering. */ /* The re-ordering algorithm is based on that used in the REORDx */ /* routines. To use this algorithm, we'll build an order vector */ /* for the records to be ordered; we'll construct this order vector */ /* in a scratch DAS file. First, we'll traverse the directories */ /* to build up a sort of inverse order vector that tells us the */ /* final destination and data type of each data record; from this */ /* inverse vector we can easily build a true order vector. The */ /* cycles of the true order vector can be traversed without */ /* repetitive searching, and with a minimum of assignment of the */ /* contents of data records to temporary variables. */ /* Allocate a scratch DAS file to keep our vectors in. */ dasops_(&scrhan); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Now build up our `inverse order vector'. This array is an */ /* inverse order vector only in loose sense: it actually consists */ /* of an integer array that contains a sequence of pairs of integers, */ /* the first of which indicates a data type, and the second of which */ /* is an ordinal number. There is one pair for each data record in */ /* the file. The ordinal number gives the ordinal position of the */ /* record described by the number pair, relative to the other records */ /* of the same type. Directory records are considered to have type */ /* `directory', which is represented by the code DIR. */ /* We also must maintain a count of records of each type. */ cleari_(&c__4, count); /* Get the file summary for the DAS file to be segregated. */ dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, lastwd); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Find the record and word positions LREC and LWORD of the last */ /* descriptor in the file, and also find the type of the descriptor */ /* LTYPE. */ maxai_(lastrc, &c__3, &lrec, &loc); lword = 0; for (i__ = 1; i__ <= 3; ++i__) { if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", i__1, "dassdr_", (ftnlen)451)] == lrec && lastwd[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dassd" "r_", (ftnlen)451)] > lword) { lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( "lastwd", i__1, "dassdr_", (ftnlen)454)]; ltype = i__; } } /* The first directory starts after the last comment record. */ recno = nresvr + ncomr + 2; while(recno <= lrec && recno > 0) { /* Read the directory record. */ dasrri_(handle, &recno, &c__1, &c__256, irec); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Increment the directory count. */ ++count[3]; /* Add the data type (`directory') and count (1) of the current */ /* record to the inverse order vector. */ dasadi_(&scrhan, &c__1, &c__4); dasadi_(&scrhan, &c__1, &count[3]); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Set up our `finite state machine' that tells us the data */ /* types of the records described by the last read directory. */ type__ = irec[8]; prvtyp = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( "prev", i__1, "dassdr_", (ftnlen)498)]; /* Now traverse the directory and update the inverse order */ /* vector based on the descriptors we find. */ more = TRUE_; i__ = 10; while(more) { /* Obtain the count for the current descriptor. */ n = (i__2 = irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("irec", i__1, "dassdr_", (ftnlen)512)], abs(i__2)); /* Update our inverse order vector to describe the positions */ /* of the N records described by the current descriptor. */ i__1 = n; for (j = 1; j <= i__1; ++j) { dasadi_(&scrhan, &c__1, &type__); i__3 = count[(i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("count", i__2, "dassdr_", (ftnlen)521)] + j; dasadi_(&scrhan, &c__1, &i__3); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } } /* Adjust the count of records of data type TYPE. */ count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge("count" , i__1, "dassdr_", (ftnlen)533)] = count[(i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("count", i__2, "dass" "dr_", (ftnlen)533)] + n; /* Find the next type. */ ++i__; if (i__ > 256 || recno == lrec && i__ > lword) { more = FALSE_; } else { if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( "irec", i__1, "dassdr_", (ftnlen)547)] > 0) { type__ = next[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("next", i__1, "dassdr_", (ftnlen)548)]; } else if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("irec", i__1, "dassdr_", (ftnlen)550)] < 0) { type__ = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dassdr_", (ftnlen)551)]; } else { more = FALSE_; } } } /* The forward pointer in this directory tells us where the */ /* next directory record is. When there are no more directory */ /* records, this pointer will be zero. */ recno = irec[1]; } /* At this point, the inverse order vector is set up. The array */ /* COUNT contains counts of the number of records of each type we've */ /* seen. Set TOTAL to the total number of records that we've going */ /* to permute. */ total = sumai_(count, &c__4); /* The next step is to build a true order vector. Let BASE be */ /* the base address for the order vector; this address is the */ /* last logical address of the inverse order vector. */ base = total << 1; /* We'll store the actual order vector in locations BASE + 1 */ /* through BASE + TOTAL. In addition, we'll build a parallel array */ /* that contains, for each element of the order vector, the type of */ /* data corresponding to that element. This type vector will */ /* reside in locations BASE + TOTAL + 1 through BASE + 2*TOTAL. */ /* Before setting the values of the order vector and its parallel */ /* type vector, we'll allocate space in the scratch DAS file by */ /* zeroing out the locations we plan to use. After this, locations */ /* BASE+1 through BASE + 2*TOTAL can be written to in random access */ /* fashion using DASUDI. */ i__1 = total << 1; for (i__ = 1; i__ <= i__1; ++i__) { dasadi_(&scrhan, &c__1, &c__0); } if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* We note that the way to construct the inverse of a permutation */ /* SIGMA in a single loop is suggested by the relation */ /* -1 */ /* SIGMA ( SIGMA(I) ) = I */ /* We'll use this method. In our case, our order vector plays */ /* the role of */ /* -1 */ /* SIGMA */ /* and the `inverse order vector' plays the role of SIGMA. We'll */ /* exclude the first directory from the order vector, since it's */ /* an exception: we wish to reserve this record. Since the first */ /* element of the order vector (logically) contains the index 1, we */ /* can ignore it. */ i__1 = total; for (i__ = 2; i__ <= i__1; ++i__) { i__2 = (i__ << 1) - 1; i__3 = (i__ << 1) - 1; dasrdi_(&scrhan, &i__2, &i__3, &type__); i__2 = i__ << 1; i__3 = i__ << 1; dasrdi_(&scrhan, &i__2, &i__3, &dest); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Set DEST to the destination location, measured as an offset */ /* from the last comment record, of the Ith record by adding */ /* on the count of the predecessors of the block of records of */ /* TYPE. */ for (j = 1; j <= 3; ++j) { if (type__ > j) { dest += count[(i__2 = j - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge( "count", i__2, "dassdr_", (ftnlen)648)]; } } /* The destination offset of each record should be incremented to */ /* allow room for the first directory record. However, we don't */ /* need to do this for directory records; they'll already have */ /* this offset accounted for. */ if (type__ != 4) { ++dest; } /* The value of element DEST of the order vector is I. */ /* Write this value to location BASE + DEST. */ i__2 = base + dest; i__3 = base + dest; dasudi_(&scrhan, &i__2, &i__3, &i__); /* We want the ith element of the order vector to give us the */ /* number of the record to move to position i (offset from the */ /* last comment record), but we want the corresponding element */ /* of the type array to give us the type of the record currently */ /* occupying position i. */ i__2 = base + i__ + total; i__3 = base + i__ + total; dasudi_(&scrhan, &i__2, &i__3, &type__); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } } /* Ok, here's what we've got in the scratch file that's still of */ /* interest: */ /* -- In integer logical addresses BASE + 1 : BASE + TOTAL, */ /* we have an order vector. The Ith element of this */ /* vector indicates the record that should be moved to */ /* location DRBASE + I in the DAS file we're re-ordering, */ /* where DRBASE is the base address of the data records */ /* (the first directory record follows the record having this */ /* index). */ /* -- In integer logical addresses BASE + TOTAL + 1 : BASE + */ /* 2*TOTAL, we have data type indicators for the records to */ /* be re-ordered. The type for the Ith record in the file, */ /* counted from the last comment record, is located in logical */ /* address BASE + TOTAL + I. */ drbase = nresvr + ncomr + 1; /* As we traverse the order vector, we flip the sign of elements */ /* we've accessed, so that we can tell when we encounter an element */ /* of a cycle that we've already traversed. */ /* Traverse the order vector. The variable START indicates the */ /* first element to look at. Ignore the first element; it's a */ /* singleton cycle. */ start = 2; while(start < total) { /* Traverse the current cycle of the order vector. */ /* We `make a hole' in the file by saving the record in position */ /* START, then we traverse the cycle in reverse order, filling in */ /* the hole at the ith position with the record whose number is */ /* the ith element of the order vector. At the end, we deposit */ /* the saved record into the `hole' left behind by the last */ /* record we moved. */ /* We're going to read and write records to and from the DAS file */ /* directly, rather than going through the buffering system. */ /* This will allow us to avoid any untoward interactions between */ /* the buffers for different data types. */ i__1 = base + total + start; i__2 = base + total + start; dasrdi_(&scrhan, &i__1, &i__2, &savtyp); i__1 = base + start; i__2 = base + start; dasrdi_(&scrhan, &i__1, &i__2, &offset); /* Save the record at the location DRBASE + START. */ if (savtyp == 1) { i__1 = drbase + start; dasioc_("READ", &unit, &i__1, savec, (ftnlen)4, (ftnlen)1024); } else if (savtyp == 2) { i__1 = drbase + start; dasiod_("READ", &unit, &i__1, saved, (ftnlen)4); } else { i__1 = drbase + start; dasioi_("READ", &unit, &i__1, savei, (ftnlen)4); } if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Let I be the index of the record that we are going to move */ /* data into next. I is an offset from the last comment record. */ i__ = start; while(offset != start) { /* Mark the order vector element by writing its negative */ /* back to the location it came from. */ i__1 = base + i__; i__2 = base + i__; i__3 = -offset; dasudi_(&scrhan, &i__1, &i__2, &i__3); /* Move the record at location */ /* DRBASE + OFFSET */ /* to location */ /* DRBASE + I */ /* There is no need to do anything about the corresponding */ /* elements of the type vector; we won't need them again. */ /* The read and write operations, as well as the temporary */ /* record required to perform the move, are dependent on the */ /* data type of the record to be moved. */ i__1 = base + total + offset; i__2 = base + total + offset; dasrdi_(&scrhan, &i__1, &i__2, &type__); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Only pick records up if we're going to put them down in */ /* a location other than their original one. */ if (i__ != offset) { if (type__ == 1) { i__1 = drbase + offset; dasioc_("READ", &unit, &i__1, crec, (ftnlen)4, (ftnlen) 1024); i__1 = drbase + i__; dasioc_("WRITE", &unit, &i__1, crec, (ftnlen)5, (ftnlen) 1024); } else if (type__ == 2) { i__1 = drbase + offset; dasiod_("READ", &unit, &i__1, drec, (ftnlen)4); i__1 = drbase + i__; dasiod_("WRITE", &unit, &i__1, drec, (ftnlen)5); } else { i__1 = drbase + offset; dasioi_("READ", &unit, &i__1, irec, (ftnlen)4); i__1 = drbase + i__; dasioi_("WRITE", &unit, &i__1, irec, (ftnlen)5); } if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } } /* OFFSET is the index of the next order vector element to */ /* look at. */ i__ = offset; i__1 = base + i__; i__2 = base + i__; dasrdi_(&scrhan, &i__1, &i__2, &offset); i__1 = base + i__ + total; i__2 = base + i__ + total; dasrdi_(&scrhan, &i__1, &i__2, &type__); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } } /* The last value of I is the location in the cycle that element */ /* START followed. Therefore, the saved record corresponding */ /* to index START should be written to this location. */ if (savtyp == 1) { i__1 = drbase + i__; dasioc_("WRITE", &unit, &i__1, savec, (ftnlen)5, (ftnlen)1024); } else if (savtyp == 2) { i__1 = drbase + i__; dasiod_("WRITE", &unit, &i__1, saved, (ftnlen)5); } else { i__1 = drbase + i__; dasioi_("WRITE", &unit, &i__1, savei, (ftnlen)5); } /* Mark the order vector element by writing its negative */ /* back to the location it came from. */ i__1 = base + i__; i__2 = base + i__; i__3 = -start; dasudi_(&scrhan, &i__1, &i__2, &i__3); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } /* Update START so that it points to the first element of a cycle */ /* of the order vector that has not yet been traversed. This will */ /* be the first positive element of the order vector in a location */ /* indexed higher than the current value of START. Note that */ /* this way of updating START guarantees that we don't have to */ /* backtrack to find an element in the next cycle. */ offset = -1; while(offset < 0 && start < total) { ++start; i__1 = base + start; i__2 = base + start; dasrdi_(&scrhan, &i__1, &i__2, &offset); if (failed_()) { chkout_("DASSDR", (ftnlen)6); return 0; } } /* At this point, START is the index of an element in the order */ /* vector that belongs to a cycle where no routine has gone */ /* before, or else START is the last index in the order vector, */ /* in which case we're done. */ } /* At this point, the records in the DAS are organized as follows: */ /* +----------------------------------+ */ /* | File record | ( 1 ) */ /* +----------------------------------+ */ /* | Reserved records | ( 0 or more ) */ /* | | */ /* +----------------------------------+ */ /* | Comment records | ( 0 or more ) */ /* | | */ /* | | */ /* +----------------------------------+ */ /* | First directory record | ( 1 ) */ /* +----------------------------------+ */ /* | Character data records | ( 0 or more ) */ /* | | */ /* +----------------------------------+ */ /* | Double precision data records | ( 0 or more ) */ /* | | */ /* +----------------------------------+ */ /* | Integer data records | ( 0 or more ) */ /* | | */ /* +----------------------------------+ */ /* | Additional directory records | ( 0 or more ) */ /* | | */ /* +----------------------------------+ */ /* Not all of the indicated components must be present; only the */ /* file record and first directory record will exist in all cases. */ /* The `additional directory records' at the end of the file serve */ /* no purpose; if more data is appended to the file, they will be */ /* overwritten. */ /* The last step in preparing the file is to fill in the first */ /* directory record with the correct information, and to update */ /* the file summary. */ recno = drbase + 1; cleari_(&c__256, irec); /* Set the logical address ranges in the directory record, for each */ /* data type. */ for (type__ = 1; type__ <= 3; ++type__) { maxadr = lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( "lastla", i__1, "dassdr_", (ftnlen)957)]; if (maxadr > 0) { minadr = 1; } else { minadr = 0; } irec[(i__1 = type__ << 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("irec", i__1, "dassdr_", (ftnlen)965)] = minadr; irec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( "irec", i__1, "dassdr_", (ftnlen)966)] = maxadr; } /* Set the descriptors in the directory. Determine which type */ /* comes first: the order of priority is character, double */ /* precision, integer. */ pos = 9; for (type__ = 1; type__ <= 3; ++type__) { if (lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("las" "tla", i__1, "dassdr_", (ftnlen)979)] > 0) { if (pos == 9) { /* This is the first type for which any data is present. */ /* We must enter a type code at position BEGDSC in the */ /* directory, and we must enter a count at position */ /* BEGDSC+1. */ irec[8] = type__; irec[9] = count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge("count", i__1, "dassdr_", (ftnlen)989)]; lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( "lastrc", i__1, "dassdr_", (ftnlen)990)] = recno; lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( "lastwd", i__1, "dassdr_", (ftnlen)991)] = 10; pos += 2; prvtyp = type__; } else { /* Place an appropriately signed count at location POS in */ /* the directory. */ if (type__ == next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("next", i__1, "dassdr_", (ftnlen)1000)]) { irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( "irec", i__1, "dassdr_", (ftnlen)1001)] = count[( i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("count", i__2, "dassdr_", (ftnlen)1001)]; } else { irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( "irec", i__1, "dassdr_", (ftnlen)1003)] = -count[( i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("count", i__2, "dassdr_", (ftnlen)1003)]; } lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( "lastrc", i__1, "dassdr_", (ftnlen)1006)] = recno; lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( "lastwd", i__1, "dassdr_", (ftnlen)1007)] = pos; ++pos; prvtyp = type__; } } } /* Since we've done away with all but the first directory, the first */ /* free record is decremented by 1 less than the directory count. */ free = free - count[3] + 1; /* Write out the new directory record. Don't use the DAS buffered */ /* write mechanism; this could trash the file by dumping buffered */ /* records in the wrong places. */ dasioi_("WRITE", &unit, &recno, irec, (ftnlen)5); /* Write out the updated file summary. */ dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, lastwd); /* Clean up the DAS data buffers: we don't want buffered scratch */ /* file records hanging around there. Then get rid of the scratch */ /* file. */ daswbr_(&scrhan); dasllc_(&scrhan); chkout_("DASSDR", (ftnlen)6); return 0; } /* dassdr_ */
/* $Procedure ZZEKTR13 ( EK tree, 1-3 split ) */ /* Subroutine */ int zzektr13_(integer *handle, integer *tree) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ integer base, root; extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_( integer *, integer *, integer *); integer i__, child[2], delta; extern /* Subroutine */ int chkin_(char *, ftnlen); integer rpage[256]; extern /* Subroutine */ int movei_(integer *, integer *, integer *); integer c1page[256], c2page[256], middle; extern /* Subroutine */ int cleari_(integer *, integer *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); integer nrkeys; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); /* $ Abstract */ /* Execute a 1-3 split: split the root node to create two new */ /* children, leaving a single key in the root. */ /* $ 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 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 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 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. */ /* $ 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. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ 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 the indicated file, the */ /* error will be diagnosed by routines called by this routine. */ /* 3) If the number of keys in the root does not correspond to an */ /* overflow of exactly 1 key, the error SPICE(BUG) is signalled. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* Insertions into an EK tree start at a leaf node. If the node */ /* overflows, the EK system attempts to shuffle keys at the leaf */ /* level to resolve the overflow. That attempt failing, the system */ /* delegates the problem upward to the next higher level. Overflow */ /* may occur there as well; if it does, the problem gets passed */ /* upward again. If the root overflows, the system makes room by */ /* executing what's called a `1-3' split: the root gets two new */ /* children, and all but one of the keys in the root are moved into */ /* the new children. The former children of the root become */ /* children of the two new children of the root. */ /* After the 1-3 split, the tree is balanced and all invariants */ /* relating to key counts are restored. */ /* The tree grows taller by one level as a result of a 1-3 split; */ /* this is the only circumstance under which the tree grows taller. */ /* Below are the gory details concerning the actions of this routine. */ /* All of the parameters referred to here (in capital letters) are */ /* defined in the include file ektree.inc. */ /* In a 1-3 split: */ /* - The leftmost MNKEYC keys of the root are moved into the */ /* new left child. */ /* - The data values associated with the first MNKEYC keys of the */ /* root are moved along with the keys. */ /* - The left child pointers associated with the first MNKEYC keys */ /* of the root are moved along with the keys. */ /* - The right child pointer of the key at location MNKEYC+1 in */ /* the root is moved to location MYKEYC+1 in the child pointer */ /* array of the left child. */ /* - The rightmost MNKEYC keys of the root are moved into the */ /* new right child. */ /* - The data values associated with the last MNKEYC keys of the */ /* root are moved along with the keys. */ /* - The left child pointers associated with the last MNKEYC keys */ /* of the root are moved along with the keys. */ /* - The right child pointer of the last in the root is moved to */ /* location MYKEYC+1 in the child pointer array of the right */ /* child. */ /* - The left child pointer of the one key left in the root */ /* points to the new left child. */ /* - The right child pointer of the one key left in the root */ /* points to the new right child. */ /* As the above list shows, each of the new children of the root */ /* contains the minimum allowed number of keys that a child node */ /* may have. Thus the size constraints on child nodes are met. */ /* The root must be non-empty unless the tree is empty; this */ /* condition is also met. */ /* $ Examples */ /* See ZZEKTRIN. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */ /* -& */ /* Local variables */ /* Use discovery check-in for speed. */ root = *tree; zzekpgri_(handle, &root, rpage); nrkeys = rpage[4]; /* The number of keys in the root must correspond exactly to an */ /* overflow level of 1 key. */ if (nrkeys != 83) { chkin_("ZZEKTR13", (ftnlen)8); setmsg_("Number of keys in root = #; should be #.", (ftnlen)40); errint_("#", &nrkeys, (ftnlen)1); errint_("#", &c__83, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKTR13", (ftnlen)8); return 0; } /* Allocate two new pages; these will become children of the root. */ /* Each one will be assigned MNKEYC keys. */ for (i__ = 1; i__ <= 2; ++i__) { zzekpgal_(handle, &c__3, &child[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("child", i__1, "zzektr13_", (ftnlen)221)], & base); } /* Set the key count in the first child. */ cleari_(&c__256, c1page); c1page[0] = 41; /* Copy in the keys, data pointers, and child pointers from the */ /* first MNKEYC locations in the root. Also take the left child */ /* pointer of the middle key. */ movei_(&rpage[5], &c__41, &c1page[1]); movei_(&rpage[172], &c__41, &c1page[128]); movei_(&rpage[88], &c__42, &c1page[64]); /* Set up the key count in the second child. */ cleari_(&c__256, c2page); c2page[0] = 41; /* Copy in the keys, data pointers, and child pointers from the */ /* last MNKEYC locations in the root. Also take the last right */ /* child pointer. */ middle = 42; movei_(&rpage[(i__1 = middle + 5) < 256 && 0 <= i__1 ? i__1 : s_rnge( "rpage", i__1, "zzektr13_", (ftnlen)254)], &c__41, &c2page[1]); movei_(&rpage[(i__1 = middle + 172) < 256 && 0 <= i__1 ? i__1 : s_rnge( "rpage", i__1, "zzektr13_", (ftnlen)255)], &c__41, &c2page[128]); movei_(&rpage[(i__1 = middle + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge( "rpage", i__1, "zzektr13_", (ftnlen)256)], &c__42, &c2page[64]); /* The keys in this second node must be adjusted to account for the */ /* loss of the predecessors assigned to the subtree headed by the */ /* left child, as well as of the middle key. */ delta = rpage[(i__1 = middle + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( "rpage", i__1, "zzektr13_", (ftnlen)263)]; for (i__ = 1; i__ <= 41; ++i__) { c2page[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("c2page", i__1, "zzektr13_", (ftnlen)266)] = c2page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("c2page", i__2, "zzektr13_", (ftnlen) 266)] - delta; } /* Now the root must be updated. The root now contains just 1 */ /* key; that key should be shifted left to the first key location. */ /* There are two child pointers; these point to the children just */ /* created. The depth of the tree has increased, as well as the */ /* number of nodes in the tree. */ rpage[5] = rpage[(i__1 = middle + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( "rpage", i__1, "zzektr13_", (ftnlen)276)]; rpage[172] = rpage[(i__1 = middle + 171) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", i__1, "zzektr13_", (ftnlen)277)]; rpage[88] = child[0]; rpage[89] = child[1]; rpage[4] = 1; ++rpage[3]; rpage[1] += 2; cleari_(&c__82, &rpage[6]); cleari_(&c__82, &rpage[173]); cleari_(&c__82, &rpage[90]); /* Write out our updates. */ zzekpgwi_(handle, &root, rpage); zzekpgwi_(handle, child, c1page); zzekpgwi_(handle, &child[1], c2page); return 0; } /* zzektr13_ */
/* $Procedure ZZEKAC01 ( EK, add class 1 column to segment ) */ /* Subroutine */ int zzekac01_(integer *handle, integer *segdsc, integer * coldsc, integer *ivals, logical *nlflgs, integer *rcptrs, integer * wkindx) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ integer page[256], tree, from; extern /* Subroutine */ int zzektr1s_(integer *, integer *, integer *, integer *), zzekcnam_(integer *, integer *, char *, ftnlen), zzekordi_(integer *, logical *, logical *, integer *, integer *), zzekpgwi_(integer *, integer *, integer *), zzekspsh_(integer *, integer *), zzektrit_(integer *, integer *); integer i__, n, p, mbase, ndata, pbase; extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); integer class__, nnull, nrows; extern logical return_(void); char column[32]; integer adrbuf[254], bufptr, colidx, dscbas, idxtyp, nulptr, nwrite, remain, to; logical indexd, nullok; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), cleari_(integer *, integer *), dasudi_(integer *, integer *, integer *, integer *), zzekaps_(integer *, integer *, integer *, logical *, integer *, integer *); /* $ Abstract */ /* Add an entire class 1 column to an EK segment. */ /* $ 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 */ /* $ 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 Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ 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 Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor 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 Column Name Size */ /* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ /* Size of column name, in characters. */ /* End Include Section: EK Column Name Size */ /* $ 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 Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page 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 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 Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer 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 Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor 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 Handle attached to new EK file. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* IVALS I Integer values to add to column. */ /* NLFLGS I Array of null flags for column entries. */ /* RCPTRS I Array of record pointers for segment. */ /* WKINDX I-O Work space for column index. */ /* $ Detailed_Input */ /* HANDLE the handle of an EK file that is open for writing. */ /* A `begin segment for fast load' operation must */ /* have already been performed for the designated */ /* segment. */ /* SEGDSC is a descriptor for the segment to which data is */ /* to be added. The segment descriptor is not */ /* updated by this routine, but some fields in the */ /* descriptor will become invalid after this routine */ /* returns. */ /* COLDSC is a descriptor for the column to be added. The */ /* column attributes must be filled in, but any */ /* pointers may be uninitialized. */ /* IVALS is an array containing the entire set of column */ /* entries for the specified column. The entries */ /* are listed in row-order: the column entry for the */ /* first row of the segment is first, followed by the */ /* column entry for the second row, and so on. The */ /* number of column entries must match the declared */ /* number of rows in the segment. Elements must be */ /* allocated for each column entry, including null */ /* entries. */ /* NLFLGS is an array of logical flags indicating whether */ /* the corresponding entries are null. If the Ith */ /* element of NLFLGS is .FALSE., the Ith column entry */ /* defined by IVALS is added to the specified segment */ /* in the specified kernel file. */ /* If the Ith element of NLFGLS is .TRUE., the */ /* contents of the Ith column entry are undefined. */ /* NLFLGS is used only for columns that allow null */ /* values; it's ignored for other columns. */ /* RCPTRS is an array of record pointers for the input */ /* segment. These pointers are base addresses of the */ /* `record pointer structures' for the segment. */ /* These pointers are used instead of record numbers */ /* in column indexes: the indexes map ordinal */ /* positions to record pointers. */ /* WKINDX is a work space array used for building a column */ /* index. If the column is indexed, the dimension of */ /* WKINDX must be at NROWS, where NROWS is the number */ /* of rows in the column. If the column is not */ /* indexed, this work space is not used, so the */ /* dimension may be any positive value. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 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. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: it modifies the named */ /* EK file by adding data to the specified column. This routine */ /* writes the entire contents of the specified column in one shot. */ /* This routine creates columns much more efficiently than can be */ /* done by sequential calls to EKACEI, but has the drawback that */ /* the caller must use more memory for the routine's inputs. This */ /* routine cannot be used to add data to a partially completed */ /* column. */ /* $ Examples */ /* See EKACLI. */ /* $ Restrictions */ /* 1) This routine assumes the EK scratch area has been set up */ /* properly for a fast load operation. This routine writes */ /* to the EK scratch area as well. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ /* Bug fix: case of 100% null data values is now handled */ /* correctly. Previous version line was changed from "Beta" */ /* to "SPICELIB." */ /* - SPICELIB Version 1.0.0, 25-SEP-1995 (NJB) */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ /* Bug fix: case of 100% null data values is now handled */ /* correctly. The test to determine when to write a page */ /* was fixed to handle this case. */ /* Previous version line was changed from "Beta" */ /* to "SPICELIB." */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKAC01", (ftnlen)8); } /* Grab the column's attributes. */ class__ = coldsc[0]; idxtyp = coldsc[5]; nulptr = coldsc[7]; colidx = coldsc[8]; nullok = nulptr != -1; indexd = idxtyp != -1; /* This column had better be class 1. */ if (class__ != 1) { zzekcnam_(handle, coldsc, column, (ftnlen)32); setmsg_("Column class code # found in descriptor for column #. Clas" "s should be 1.", (ftnlen)73); errint_("#", &class__, (ftnlen)1); errch_("#", column, (ftnlen)1, (ftnlen)32); sigerr_("SPICE(NOCLASS)", (ftnlen)14); chkout_("ZZEKAC01", (ftnlen)8); return 0; } /* If the column is indexed, the index type should be 1; we don't */ /* know how to create any other type of index. */ if (indexd && idxtyp != 1) { zzekcnam_(handle, coldsc, column, (ftnlen)32); setmsg_("Index type code # found in descriptor for column #. Code s" "hould be 1.", (ftnlen)70); errint_("#", &idxtyp, (ftnlen)1); errch_("#", column, (ftnlen)1, (ftnlen)32); sigerr_("SPICE(UNRECOGNIZEDTYPE)", (ftnlen)23); chkout_("ZZEKAC01", (ftnlen)8); return 0; } /* Push the column's ordinal index on the stack. This allows us */ /* to identify the column the addresses belong to. */ zzekspsh_(&c__1, &colidx); /* Find the number of rows in the segment. */ nrows = segdsc[5]; /* Decide how many pages we'll need to store the data. Also */ /* record the number of data values to write. */ if (nullok) { /* Count the non-null rows; these are the ones that will take */ /* up space. */ nnull = 0; i__1 = nrows; for (i__ = 1; i__ <= i__1; ++i__) { if (nlflgs[i__ - 1]) { ++nnull; } } ndata = nrows - nnull; } else { ndata = nrows; } if (ndata > 0) { /* There's some data to write, so allocate a page. Also */ /* prepare a data buffer to be written out as a page. */ zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase); cleari_(&c__256, page); } /* Write the input data out to the target file a page at a time. */ /* Null values don't get written. */ /* While we're at it, we'll push onto the EK stack the addresses */ /* of the column entries. We use the constant NULL rather than an */ /* address to represent null entries. */ /* We'll use FROM to indicate the element of IVALS we're */ /* considering, TO to indicate the element of PAGE to write */ /* to, and BUFPTR to indicate the element of ADRBUF to write */ /* addresses to. The variable N indicates the number of data */ /* items in the current page. */ remain = nrows; from = 1; to = 1; bufptr = 1; nwrite = 0; n = 0; while(remain > 0) { if (nullok && nlflgs[from - 1]) { adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge( "adrbuf", i__1, "zzekac01_", (ftnlen)378)] = -2; } else { adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge( "adrbuf", i__1, "zzekac01_", (ftnlen)382)] = to + pbase; page[(i__1 = to - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzekac01_", (ftnlen)383)] = ivals[from - 1]; ++to; ++nwrite; ++n; } ++from; --remain; if (bufptr == 254 || remain == 0) { /* The address buffer is full or we're out of input values */ /* to look at, so push the buffer contents on the stack. */ zzekspsh_(&bufptr, adrbuf); bufptr = 1; } else { ++bufptr; } if (n == 254 || nwrite == ndata && ndata != 0) { /* Either the current data page is full, or we've buffered */ /* the last of the available data. It's time to write out the */ /* current page. First set the link count. */ page[255] = n; /* Write out the data page. */ zzekpgwi_(handle, &p, page); /* If there's more data to write, allocate another page. */ if (nwrite < ndata) { zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase); cleari_(&c__256, page); n = 0; to = 1; } } } /* If the column is supposed to have an index, now is the time to */ /* build that index. We'll find the order vector for the input */ /* values, overwrite the elements of the order vector with the */ /* corresponding elements of the input array of record pointers, then */ /* load this sorted copy of the record pointer array into a tree in */ /* one shot. */ if (indexd) { zzekordi_(ivals, &nullok, nlflgs, &nrows, wkindx); i__1 = nrows; for (i__ = 1; i__ <= i__1; ++i__) { wkindx[i__ - 1] = rcptrs[wkindx[i__ - 1] - 1]; } zzektrit_(handle, &tree); zzektr1s_(handle, &tree, &nrows, wkindx); /* Update the segment's metadata to point to the index. The */ /* pointer indicates the root page of the tree. */ mbase = segdsc[2]; dscbas = mbase + 24 + (colidx - 1) * 11; i__1 = dscbas + 7; i__2 = dscbas + 7; dasudi_(handle, &i__1, &i__2, &tree); } chkout_("ZZEKAC01", (ftnlen)8); return 0; } /* zzekac01_ */
/* $Procedure ZZEKINQC ( Private: EK, insert into query, character ) */ /* Subroutine */ int zzekinqc_(char *value, integer *length, integer *lexbeg, integer *lexend, integer *eqryi, char *eqryc, integer *descr, ftnlen value_len, ftnlen eqryc_len) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ integer i_len(char *, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ integer free, init, size, room; extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, ftnlen), zzekweqi_(char *, integer *, integer *, ftnlen); integer l; extern /* Subroutine */ int chkin_(char *, ftnlen), cleari_(integer *, integer *), setmsg_(char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, ftnlen); /* $ Abstract */ /* SPICE Private routine intended solely for the support of SPICE */ /* routines. Users should not call this routine directly due */ /* to the volatile nature of this routine. */ /* Insert a character value into a specified encoded EK query, and */ /* obtain a descriptor for the stored value. */ /* $ 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 Encoded Query Internal Parameters */ /* ekquery.inc Version 3 16-NOV-1995 (NJB) */ /* Updated to reflect increased value of MAXCON in */ /* ekqlimit.inc. */ /* ekquery.inc Version 2 03-AUG-1995 (NJB) */ /* Updated to support representation of the SELECT clause. */ /* ekquery.inc Version 1 12-JAN-1995 (NJB) */ /* An encoded EK query is an abstract data type implemented */ /* as an integer cell, along with a double precision cell and */ /* a character string. The d.p. cell and string contain numeric */ /* and string values from the query string represented by the */ /* encoded query. */ /* The parameters in this file are intended for use only by the */ /* EK encoded query access routines. Callers of EK routines should */ /* not use these parameters. */ /* The following parameters are indices of specified elements */ /* in the integer portion of the encoded query. */ /* Encoded query architecture type: */ /* `Name resolution' consists of: */ /* - Verifying existence of tables: any table names listed */ /* in the FROM clause of a query must be loaded. */ /* - Validating table aliases used to qualify column names. */ /* - Verifying existence of columns and obtaining data types */ /* for columns. */ /* - Setting data type codes for literal values in the encoded */ /* query. */ /* - Checking consistency of operators and operand data types. */ /* - Making sure unqualified column names are unambiguous. */ /* - For constraints, mapping the table names used to qualify */ /* column names to the ordinal position in the FROM clause */ /* of the corresponding table. */ /* Initialization status---this flag indicates whether the encoded */ /* query has been initialized. Values are ITRUE or IFALSE. See the */ /* include file ekbool.inc for parameter values. */ /* Parse status---this flag indicates whether the parsing operation */ /* that produced an encoded query has been completed. Values are */ /* ITRUE or IFALSE. */ /* Name resolution status---this flag indicates whether names */ /* have been resolved in an encoded query. Values are ITRUE or */ /* IFALSE. */ /* Time resolution status---this flag indicates whether time values */ /* have been resolved in an encoded query. Time resolution */ /* consists of converting strings representing time values to ET. */ /* Values of the status are ITRUE or IFALSE. */ /* Semantic check status---this flag indicates whether semantic */ /* checking of constraints has been performed. */ /* Number of tables specified in FROM clause: */ /* Number of constraints in query: */ /* A special value is used to indicate the `maximal' constraint--- */ /* one that logically cannot be satisfied. If the constraints */ /* are equivalent to the maximal constraint, the location EQNCNS */ /* is assigned the value EQMXML */ /* Number of constraint conjunctions: */ /* Number of order-by columns: */ /* Number of SELECT columns: */ /* Size of double precision buffer: */ /* `Free' pointer into double precision buffer: */ /* Size of character string buffer: */ /* `Free' pointer into character string buffer: */ /* The following four base pointers will be valid after a query */ /* has been parsed: */ /* Base pointer for SELECT column descriptors: */ /* Base pointer for constraint descriptors: */ /* Base pointer for conjunction sizes: */ /* Base pointer for order-by column descriptors: */ /* After the quantities named above, the integer array contains */ /* series of descriptors for tables, constraints, and order-by */ /* columns, as well as a list of `conjunction sizes'---that is, */ /* the sizes of the groups of constraints that form conjunctions, */ /* after the input query has been re-arranged as a disjunction of */ /* conjunctions of constraints. */ /* The offsets of specific elements within descriptors are */ /* parameterized. The base addresses of the descriptors themselves */ /* must be calculated using the counts and sizes of the items */ /* preceding them. */ /* A diagram of the structure of the variable-size portion of the */ /* integer array is shown below: */ /* +-------------------------------------+ */ /* | Fixed-size portion of encoded query | */ /* +-------------------------------------+ */ /* | Encoded FROM clause | */ /* +-------------------------------------+ */ /* | Encoded constraint clause | */ /* +-------------------------------------+ */ /* | Conjunction sizes | */ /* +-------------------------------------+ */ /* | Encoded ORDER BY clause | */ /* +-------------------------------------+ */ /* | Encoded SELECT clause | */ /* +-------------------------------------+ */ /* Value Descriptors */ /* ---------------- */ /* In order to discuss the various descriptors below, we'll make use */ /* of sub-structures called `value descriptors'. These descriptors */ /* come in two flavors: character and double precision. For */ /* strings, a descriptor is a set of begin and end pointers that */ /* indicate the location of the string in the character portion of an */ /* encoded query, along with the begin and end pointers for the */ /* corresponding lexeme in the original query. The pointers are set */ /* to zero when they are not in use, for example if they refer to an */ /* optional lexeme that did not appear in the input query. */ /* All value descriptors start with a data type indicator; values */ /* are from ektype.inc. Integer and time values are referred to */ /* by double precision descriptors. */ /* Parameters for string value descriptor elements: */ /* Numeric value descriptors are similar to those for string values, */ /* the difference being that they have only one pointer to the value */ /* they represent. This pointer is the index of the value in the */ /* encoded query's numeric buffer. */ /* All value descriptors have the same size. In order to allow */ /* table descriptors to have the same size as value descriptors, */ /* we include an extra element in the descriptor. */ /* Column Descriptors */ /* ----------------- */ /* Each column descriptor consists of a character descriptor for the */ /* name of the column, followed by an index, which gives the ordinal */ /* position of the column in the logical table to which the column */ /* belongs. The index element is filled in during name resolution. */ /* Table Descriptors */ /* ----------------- */ /* Each table descriptor consists of a character descriptor for the */ /* name of the table, followed by an index, which gives the ordinal */ /* position of the table in the FROM clause in the original query. */ /* The index element is filled in during name resolution. Aliases */ /* and table names have identical descriptor structures. */ /* Constraint descriptors */ /* ------------------ */ /* Each constraint is characterized by: */ /* - A code indicating whether the constraint compares values */ /* in two columns or the value in a column and a literal */ /* value. The values of this element are EQCOL and EQVAL. */ /* - A descriptor for the table used to qualify the */ /* column name on the left side of the constraint. */ /* - A character value descriptor for the column name on the left */ /* side of the query. */ /* - An operator code indicating the relational operator used */ /* in the constraint. */ /* If the constraint compares values from two columns, the */ /* next items are table and column name descriptors that apply to */ /* the column named on the right side of the relational operator. */ /* If the constraint has a literal value on the right side, the */ /* operator code is followed by... */ /* - a value descriptor. */ /* - Size of a constraint descriptor: */ /* Conjunction sizes */ /* ----------------- */ /* The size of each conjunction of constraints occupies a single */ /* integer. */ /* Order-by Column Descriptors */ /* --------------------------- */ /* Each order-by column descriptor contains descriptors for */ /* the table containing the column and for the name of the column */ /* itself; one additional element is used to indicate the direction */ /* of the ordering (ascending vs descending). */ /* - The last integer in the descriptor indicates whether the */ /* order direction is ascending or descending. */ /* - Size of an order-by column descriptor: */ /* Codes indicating sense of ordering (ascending vs descending): */ /* SELECT Column Descriptors */ /* --------------------------- */ /* Each SELECT column descriptor contains descriptors for */ /* the table containing the column and for the name of the column */ /* itself. */ /* - Size of a SELECT column descriptor: */ /* Miscellaneous parameters: */ /* EQIMIN is the minimum size of the integer portion of */ /* an encoded query. EQIMIN depends on the parameters */ /* MAXTAB */ /* MAXCON */ /* MAXORD */ /* MAXSEL */ /* all of which are declared in the include file ekqlimit.inc. */ /* The functional definition of EQIMIN is: */ /* INTEGER EQIMIN */ /* PARAMETER ( EQIMIN = EQVBAS */ /* . + MAXTAB * EQVDSZ * 2 */ /* . + MAXCON * EQCDSZ */ /* . + MAXCON */ /* . + MAXORD * EQODSZ */ /* . + MAXSEL * EQSDSZ ) */ /* End Include Section: EK Encoded Query Internal 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 */ /* $ 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 Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* VALUE I Character value. */ /* LENGTH I Length of item to insert. */ /* LEXBEG, */ /* LEXEND I Begin and end positions of value's lexeme. */ /* EQRYI I-O Integer portion of encoded query. */ /* EQRYC I-O Character portion of encoded query. */ /* DESCR O Descriptor for value. */ /* $ Detailed_Input */ /* VALUE is a character value to be inserted into an */ /* encoded query. */ /* LENGTH indicates the length of the input character value. */ /* If LENGTH exceeds LEN(VALUE), the stored value */ /* is padded with trailing blanks. This allows */ /* faithful representation of literal strings. */ /* LEXBEG, */ /* LEXEND are the begin and end character positions in the */ /* original query of the lexeme that generated the */ /* input value. These indices may be used for error */ /* correction. */ /* EQRYI is the integer portion of an encoded EK query */ /* EQRYC is the character portion of an encoded EK query. */ /* $ Detailed_Output */ /* EQRYI is the integer portion of an encoded EK query, */ /* updated to reflect the addition of a value to the */ /* encoded query's character buffer. */ /* EQRYC is the character portion of an encoded EK query, */ /* with the input value added. */ /* DESCR is a descriptor for the input value. The */ /* descriptor contains EQVDSZ elements. */ /* $ Parameters */ /* See the INCLUDE files. */ /* $ Exceptions */ /* 1) If the input query is uninitialized, the error */ /* SPICE(NOTINITIALIZED) will be signalled. */ /* 2) If the input character count LENGTH is non-positive, the */ /* error SPICE(INVALIDCOUNT) is signalled. */ /* 3) If there is insufficient space in the encoded query's */ /* character component, the error SPICE(BUFFERTOOSMALL) is */ /* signalled. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine should always be used to insert character values */ /* into an encoded query; the insertion should never be done */ /* directly. */ /* $ Examples */ /* See ZZEKNRML. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ zzekreqi_(eqryi, "INITIALIZED", &init, (ftnlen)11); if (init != 1) { chkin_("ZZEKINQC", (ftnlen)8); setmsg_("Encoded query must be initialized before it may be written.", (ftnlen)59); sigerr_("SPICE(NOTINITIALIZED)", (ftnlen)21); chkout_("ZZEKINQC", (ftnlen)8); return 0; } /* Check the input length value. */ if (*length < 1) { chkin_("ZZEKINQC", (ftnlen)8); setmsg_("Length of string value was #; must be > 0.", (ftnlen)42); errint_("#", length, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("ZZEKINQC", (ftnlen)8); return 0; } /* Get the character free pointer; make sure there's enough room. */ zzekreqi_(eqryi, "FREE_CHR", &free, (ftnlen)8); zzekreqi_(eqryi, "CHR_BUF_SIZE", &size, (ftnlen)12); room = size - free + 1; if (*length > room) { chkin_("ZZEKINQC", (ftnlen)8); setmsg_("Out of room in character portion of encoded query; only # e" "lements were available; # are needed.", (ftnlen)96); errint_("#", &room, (ftnlen)1); errint_("#", length, (ftnlen)1); sigerr_("SPICE(BUFFERTOOSMALL)", (ftnlen)21); chkout_("ZZEKINQC", (ftnlen)8); return 0; } /* Insert the value into the character portion of the encoded query. */ /* Computing MIN */ i__1 = *length, i__2 = i_len(value, value_len); l = min(i__1,i__2); s_copy(eqryc + (free - 1), value, eqryc_len - (free - 1), l); /* Fill in the descriptor. */ cleari_(&c__6, descr); descr[0] = 1; descr[1] = *lexbeg; descr[2] = *lexend; descr[3] = free; descr[4] = free + *length - 1; /* Update the character free pointer. */ i__1 = free + *length; zzekweqi_("FREE_CHR", &i__1, eqryi, (ftnlen)8); return 0; } /* zzekinqc_ */
/* $Procedure ZZEKTR1S ( EK tree, one-shot load ) */ /* Subroutine */ int zzektr1s_(integer *handle, integer *tree, integer *size, integer *values) { /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ integer base, page[256], nbig, node, subd, next, unit; extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_( integer *, integer *, integer *); extern integer zzektrbs_(integer *); integer d__, i__, n, q, child, s; extern integer zzektrsz_(integer *, integer *); extern /* Subroutine */ int chkin_(char *, ftnlen); integer level, nkids, npred, nkeys, tsize, kidbas; extern /* Subroutine */ int cleari_(integer *, integer *), dasudi_( integer *, integer *, integer *, integer *); integer basidx; extern /* Subroutine */ int dashlu_(integer *, integer *); integer bigsiz, nnodes, nsmall, stnbig[10], stnbas[10], stnode[10]; extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen); extern logical return_(void); integer maxsiz, reqsiz, stlsiz[10], stnext[10], stnkey[10], stsbsz[10], subsiz, totnod; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); integer div, key; /* $ Abstract */ /* One-shot tree load: insert an entire array into an empty */ /* tree. */ /* $ 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. */ /* SIZE I Size of tree. */ /* VALUES I Values to insert. */ /* $ 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. */ /* The tree must be empty. */ /* SIZE is the size of the tree to create: SIZE is the */ /* number of values that will be inserted into the */ /* tree. */ /* VALUES is an array of integer values to be inserted into */ /* the tree. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ 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 tree is not empty, the error SPICE(NONEMPTYTREE) */ /* is signalled. */ /* 4) If the depth of the tree needed to hold the number of values */ /* indicated by SIZE exceeds the maximum depth limit, the error */ /* SPICE(COUNTTOOLARGE) is signalled. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine creates an EK tree and loads the tree with the */ /* integer values supplied in the array VALUES. The ordinal */ /* positions of the values in the tree correspond to the positions */ /* of the values in the input array: for example, the 10th element */ /* of the array is pointed to by the key 10. */ /* This routine loads a tree much faster than can be done by */ /* sequentially loading the set of values by successive calls to */ /* ZZEKTRIN. On the other hand, the caller must declare an array */ /* large enough to hold all of the values to be loaded. Note that */ /* a partially full tree cannot be extended using this routine. */ /* $ Examples */ /* See EKFFLD. */ /* $ 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.1.0, 18-JUN-1999 (WLT) */ /* Removed redundant calls to CHKIN */ /* - Beta Version 1.0.0, 22-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKTR1S", (ftnlen)8); } /* Make sure the input tree is empty. */ tsize = zzektrsz_(handle, tree); if (tsize > 0) { dashlu_(handle, &unit); setmsg_("Tree has size #; should be empty.EK = #; TREE = #.", (ftnlen) 50); errint_("#", &tsize, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); errint_("#", tree, (ftnlen)1); sigerr_("SPICE(NONEMPTYTREE)", (ftnlen)19); chkout_("ZZEKTR1S", (ftnlen)8); return 0; } /* Compute the tree depth required. The largest tree of a given */ /* depth D contains the root node plus S(D) child nodes, where */ /* S(1) = 1 */ /* and if D is at least 2, */ /* D - 2 */ /* ____ */ /* \ i */ /* S(D) = MAX_SIZE * / MAX_SIZE */ /* Root ---- Child */ /* i = 0 */ /* D - 2 */ /* ____ */ /* \ i */ /* = MXKIDR * / MXKIDC */ /* ---- */ /* i = 0 */ /* D-1 */ /* MXKIDC - 1 */ /* = MXKIDR * ------------- */ /* MXKIDC - 1 */ /* If all of these nodes are full, the number of keys that */ /* can be held in this tree is */ /* MXKEYR + S(D) * MXKEYC */ /* We want the minimum value of D such that this expression */ /* is greater than or equal to SIZE. */ tsize = 82; d__ = 1; s = 1; while(tsize < *size) { ++d__; if (d__ == 2) { s = 82; } else { /* For computational purposes, the relationship */ /* S(D+1) = MXKIDR + MXKIDC * S(D) */ /* is handy. */ s = s * 63 + 83; } tsize = s * 62 + 82; } /* If the tree must be deeper than we expected, we've a problem. */ if (d__ > 10) { dashlu_(handle, &unit); setmsg_("Tree has depth #; max supported depth is #.EK = #; TREE = #." , (ftnlen)60); errint_("#", &d__, (ftnlen)1); errint_("#", &c__10, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); errint_("#", tree, (ftnlen)1); sigerr_("SPICE(COUNTTOOLARGE)", (ftnlen)20); chkout_("ZZEKTR1S", (ftnlen)8); return 0; } /* The basic error checks are done. At this point, we can build the */ /* tree. */ /* The approach is to fill in the tree in a top-down fashion. */ /* We decide how big each subtree of the root will be; this */ /* information allows us to decide which keys actually belong */ /* in the root. Having filled in the root, we repeat the process */ /* for each subtree of the root in left-to-right order. */ /* We use a stack to keep track of the ancestors of the */ /* node we're currently considering. The table below shows the */ /* items we save on the stack and the stack variables associated */ /* with those items: */ /* Item Stack Variable */ /* ---- --------------- */ /* Node number STNODE */ /* Size, in keys, of the */ /* subtree headed by node STSBSZ */ /* Number of keys in node STNKEY */ /* Larger subtree size STLSIZ */ /* Number of large subtrees STNBIG */ /* Index of next subtree to visit STNEXT */ /* Base index of node STNBAS */ node = *tree; subsiz = *size; next = 1; level = 1; basidx = 0; while(level > 0) { /* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */ if (next == 1) { /* This node has not been visited yet. We'll fill in this */ /* node before proceeding to fill in its descendants. The */ /* first step is to compute the number and sizes of the */ /* subtrees of this node. */ /* Decide the large subtree size and the number of subtrees of */ /* this node. The depth SUBD of the subtrees of this node is */ /* D - LEVEL. Each subtree has size bounded by the sizes of */ /* the subtree of depth SUBD in which all nodes contain MNKEYC */ /* keys and the by the subtree of depth SUBD in which all nodes */ /* contain MXKEYC keys. If this node is not the root and is */ /* not a leaf node, the number of subtrees must be between */ /* MNKIDC and MXKIDC. */ if (level == 1) { /* We're working on the root. The number of subtrees is */ /* anywhere between 0 and MXKIDR, inclusive. We'll create */ /* a tree with the minimum number of subtrees of the root. */ if (d__ > 1) { /* We'll find the number of subtrees of maximum size */ /* that we would need to hold the non-root keys of the */ /* tree. We'll then determine the actual required sizes */ /* of these subtrees. */ subd = d__ - 1; nnodes = 0; i__1 = subd; for (i__ = 1; i__ <= i__1; ++i__) { nnodes = nnodes * 63 + 1; } maxsiz = nnodes * 62; /* If we had NKIDS subtrees of size MAXSIZ, NKIDS */ /* would be the smallest integer such that */ /* ( NKIDS - 1 ) + NKIDS * MAXSIZ > SUBSIZ */ /* - */ /* or equivalently, */ /* NKIDS * ( MAXSIZ + 1 ) > SUBSIZ + 1 */ /* - */ /* We'll compute this value of NKIDS. */ q = subsiz + 1; div = maxsiz + 1; nkids = (q + div - 1) / div; /* The minimum number of keys we must store in child */ /* nodes is the number of keys in the tree, minus those */ /* that can be accommodated in the root: */ n = subsiz - (nkids - 1); /* Now we can figure out how large the subtrees would */ /* have to be in order to hold N keys, if all subtrees */ /* had the same size. */ bigsiz = (n + nkids - 1) / nkids; /* We may have more capacity than we need if all subtrees */ /* have size BIGSIZ. So, we'll allow some subtrees to */ /* have size BIGSIZ-1. Not all subtrees can have the */ /* smaller size (otherwise BIGSIZ would have been */ /* smaller). The first NBIG subtrees will have the */ /* larger size. */ nsmall = nkids * bigsiz - n; nbig = nkids - nsmall; nkeys = nkids - 1; } else { /* All keys are in the root. */ nkeys = *size; nkids = 0; } /* Read in the root page. */ zzekpgri_(handle, tree, page); /* We have enough information to fill in the root node. */ /* We'll allocate nodes for the immediate children. */ /* There is one key `between' each child pointer. */ i__1 = nkeys; for (i__ = 1; i__ <= i__1; ++i__) { /* The Ith key may be found by considering the number */ /* of keys in the subtree between the Ith key and its */ /* predecessor in the root. */ if (i__ == 1) { npred = 0; } else { npred = page[(i__2 = i__ + 3) < 256 && 0 <= i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_", ( ftnlen)480)]; } if (d__ > 1) { /* The tree contains subtrees. */ if (i__ <= nbig) { key = npred + bigsiz + 1; } else { key = npred + bigsiz; } } else { key = i__; } page[(i__2 = i__ + 4) < 256 && 0 <= i__2 ? i__2 : s_rnge( "page", i__2, "zzektr1s_", (ftnlen)499)] = key; page[(i__2 = i__ + 171) < 256 && 0 <= i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_", (ftnlen)500)] = values[key - 1]; } totnod = 1; i__1 = nkids; for (i__ = 1; i__ <= i__1; ++i__) { /* Allocate a node for the Ith child. Store pointers */ /* to these nodes. */ zzekpgal_(handle, &c__3, &child, &base); page[(i__2 = i__ + 87) < 256 && 0 <= i__2 ? i__2 : s_rnge( "page", i__2, "zzektr1s_", (ftnlen)513)] = child; ++totnod; } /* Fill in the root's metadata. There is one item that */ /* we'll have to fill in when we're done: the number of */ /* nodes in the tree. We know the rest of the information */ /* now. */ page[2] = *size; page[3] = d__; page[4] = nkeys; page[1] = 0; /* Write out the root. */ zzekpgwi_(handle, tree, page); } else if (level < d__) { /* The current node is a non-leaf child node. */ cleari_(&c__256, page); /* The tree headed by this node has depth D-LEVEL+1 and */ /* must hold SUBSIZ keys. We must figure out the size */ /* and number of subtrees of the current node. Unlike in */ /* the case of the root, we must have between MNKIDC */ /* and MXKIDC subtrees of this node. We start out by */ /* computing the required subtree size if there were */ /* exactly MNKIDC subtrees. In this case, the total */ /* number of keys in the subtrees would be */ /* SUBSIZ - MNKEYC */ n = subsiz - 41; reqsiz = (n + 40) / 41; /* Compute the maximum allowable number of keys in */ /* a subtree. */ subd = d__ - level; nnodes = 0; i__1 = subd; for (i__ = 1; i__ <= i__1; ++i__) { nnodes = nnodes * 63 + 1; } maxsiz = nnodes * 62; /* If the number REQSIZ we came up with is a valid size, */ /* we'll be able to get the correct number of children */ /* by using subtrees of size REQSIZ and REQSIZ-1. Note */ /* that it's impossible for REQSIZ to be too small, */ /* since the smallest possible number of subtrees is */ /* MNKIDC. */ if (reqsiz <= maxsiz) { /* Decide how many large and small subtrees we need. */ nkids = 42; bigsiz = reqsiz; nsmall = bigsiz * nkids - n; nbig = nkids - nsmall; } else { /* See how many subtrees of size MAXSIZ it would take */ /* to hold the requisite number of keys. We know the */ /* number is more than MNKIDC. If we have NKIDS */ /* subtrees of size MAXSIZ, the total number of */ /* keys in the subtree headed by NODE is */ /* ( NKIDS - 1 ) + ( NKIDS * MAXSIZ ) */ /* or */ /* NKIDS * ( MAXSIZ + 1 ) - 1 */ /* We must find the smallest value of NKIDS such */ /* that the above quantity is greater than or equal */ /* to SUBSIZ. */ q = subsiz + 1; div = maxsiz + 1; nkids = (q + div - 1) / div; /* We know that NKIDS subtrees of size MAXSIZ, plus */ /* NKIDS-1 keys in NODE, can hold at least SUBSIZ */ /* keys. We now want to find the smallest subtree */ /* size such that NKIDS subtrees of that size, */ /* together with the NKIDS-1 keys in NODE, contain */ /* at least SUBSIZ keys. The size we seek will */ /* become BIGSIZ, the larger of the two subtree */ /* sizes we'll use. So BIGSIZ is the smallest */ /* integer such that */ /* ( NKIDS - 1 ) + ( NKIDS * BIGSIZ ) > SUBSIZ */ /* - */ /* or equivalently */ /* BIGSIZ * NKIDS > SUBSIZ - NKIDS + 1 */ /* - */ q = subsiz - nkids + 1; div = nkids; bigsiz = (q + div - 1) / div; nsmall = bigsiz * nkids - q; nbig = nkids - nsmall; } /* Fill in the keys for the current node. */ nkeys = nkids - 1; i__1 = nkeys; for (i__ = 1; i__ <= i__1; ++i__) { /* The Ith key may be found by considering the number */ /* of keys in the subtree between the Ith key and its */ /* predecessor in the current node. */ if (i__ == 1) { npred = basidx; } else { npred = basidx + page[(i__2 = i__ - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_" , (ftnlen)652)]; } if (i__ <= nbig) { key = npred + bigsiz + 1; } else { key = npred + bigsiz; } page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge( "page", i__2, "zzektr1s_", (ftnlen)661)] = key - basidx; page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_", (ftnlen)662)] = values[key - 1]; } i__1 = nkids; for (i__ = 1; i__ <= i__1; ++i__) { /* Allocate a node for the Ith child. Store pointers */ /* to these nodes. */ zzekpgal_(handle, &c__3, &child, &base); page[(i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge( "page", i__2, "zzektr1s_", (ftnlen)674)] = child; ++totnod; } /* We can now fill in the metadata for the current node. */ page[0] = nkeys; zzekpgwi_(handle, &node, page); } /* Unless the current node is a leaf node, prepare to visit */ /* the first child of the current node. */ if (level < d__) { /* Push our current state. */ stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stnode", i__1, "zzektr1s_", (ftnlen)696)] = node; stsbsz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stsbsz", i__1, "zzektr1s_", (ftnlen)697)] = subsiz; stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stnkey", i__1, "zzektr1s_", (ftnlen)698)] = nkeys; stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stlsiz", i__1, "zzektr1s_", (ftnlen)699)] = bigsiz; stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stnbig", i__1, "zzektr1s_", (ftnlen)700)] = nbig; stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stnext", i__1, "zzektr1s_", (ftnlen)701)] = 2; stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stnbas", i__1, "zzektr1s_", (ftnlen)702)] = basidx; /* NEXT is already set to 1. BASIDX is set, since the */ /* base index of the first child is that of the parent. */ if (level == 1) { kidbas = 88; } else { kidbas = 64; } ++level; node = page[(i__1 = kidbas) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektr1s_", (ftnlen)715)]; subsiz = bigsiz; } else if (level > 1) { /* The current node is a child leaf node. There are no */ /* calculations to do; we simply assign keys and pointers, */ /* write out metadata, and pop our state. */ nkeys = subsiz; i__1 = nkeys; for (i__ = 1; i__ <= i__1; ++i__) { key = basidx + i__; page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge( "page", i__2, "zzektr1s_", (ftnlen)730)] = i__; page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_", (ftnlen)731)] = values[key - 1]; } /* We can now fill in the metadata for the current node. */ page[0] = nkeys; zzekpgwi_(handle, &node, page); /* A leaf node is a subtree unto itself, and we're */ /* done with this subtree. Pop our state. */ --level; if (level >= 1) { node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)750) ]; nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnkey", i__1, "zzektr1s_", ( ftnlen)751)]; bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( ftnlen)752)]; nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)753) ]; next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)754) ]; basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( ftnlen)755)]; nkids = nkeys + 1; /* Read in the current node. */ zzekpgri_(handle, &node, page); } } else { /* The only node is the root. Pop out. */ level = 0; } /* We've decided which node to go to next at this point. */ /* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */ } else { /* The current node has been visited already. Visit the */ /* next child, if there is one. */ if (next <= nkids) { /* Prepare to visit the next child of the current node. */ stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "stnext", i__1, "zzektr1s_", (ftnlen)787)] = next + 1; if (level == 1) { kidbas = 88; } else { kidbas = 64; } node = page[(i__1 = kidbas + next - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektr1s_", (ftnlen)797)] ; if (next <= nbig) { subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( ftnlen)801)]; } else { subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( ftnlen)803)] - 1; } if (next <= nbig + 1) { basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( ftnlen)809)] + (next - 1) * stlsiz[(i__2 = level - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz", i__2, "zzektr1s_", (ftnlen)809)] + (next - 1); } else { basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( ftnlen)815)] + nbig * stlsiz[(i__2 = level - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz", i__2, "zzektr1s_", (ftnlen)815)] + (next - nbig - 1) * ( stlsiz[(i__3 = level - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("stlsiz", i__3, "zzektr1s_", ( ftnlen)815)] - 1) + (next - 1); } ++level; next = 1; /* LEVEL, NEXT, NODE, SUBSIZ, and BASIDX are set. */ } else { /* We're done with the current subtree. Pop the stack. */ --level; if (level >= 1) { node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)836) ]; nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnkey", i__1, "zzektr1s_", ( ftnlen)837)]; bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( ftnlen)838)]; nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)839) ]; next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)840) ]; basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( ftnlen)841)]; nkids = nkeys + 1; /* Read in the current node. */ zzekpgri_(handle, &node, page); } } } /* On this pass through the loop, we either--- */ /* - Visited a node for the first time and filled in the */ /* node. */ /* - Advanced to a new node that has not yet been visited. */ /* - Exited from a completed subtree. */ /* Each of these actions can be performed a finite number of */ /* times. Therefore, we made progress toward loop termination. */ } /* The last chore is setting the total number of nodes in the root. */ base = zzektrbs_(tree); i__1 = base + 2; i__2 = base + 2; dasudi_(handle, &i__1, &i__2, &totnod); chkout_("ZZEKTR1S", (ftnlen)8); return 0; } /* zzektr1s_ */
/* $Procedure ZZEKVADR ( Compute row vector address ) */ /* Subroutine */ int zzekvadr_0_(int n__, integer *njrs, integer *bases, integer *rwvidx, integer *rwvbas, integer *sgvbas) { /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ static integer rbas[200]; extern /* Subroutine */ int zzekstop_(integer *); static integer i__, j; extern /* Subroutine */ int chkin_(char *, ftnlen); static integer ntabs, svbas[200]; extern /* Subroutine */ int cleari_(integer *, integer *); static integer begidx[200], reloff, addrss; extern /* Subroutine */ int sigerr_(char *, ftnlen); extern integer lstlei_(integer *, integer *, integer *); extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, ftnlen); static integer jrsidx; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); static integer maxrwv, svnjrs, top, nsv; extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *); /* $ Abstract */ /* Given a union of EK join row sets and a row vector index, */ /* compute the EK scratch area base address of the row vector having */ /* the specified index. Also return the base address of the row */ /* vector's parent segment vector. */ /* $ 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 */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Entry points */ /* -------- --- -------------------------------------------------- */ /* NJRS I ZZEKVSET */ /* BASES I ZZEKVSET */ /* RWVIDX I ZZEKVACL */ /* RWVBAS O ZZEKVACL */ /* SGVBAS O ZZEKVACL */ /* MXJOIN P Maximum number of tables that can be joined. */ /* MXJRS P Maximum number of join row sets allowed in union. */ /* $ Detailed_Input */ /* See the entry points for a discussion of their arguments. */ /* $ Detailed_Output */ /* See the entry points for a discussion of their arguments. */ /* $ Parameters */ /* MXJOIN is the maximum number of tables that can be joined. */ /* MXJRS is the maximum number of join row sets allowed in */ /* in the input union identified by BASES and NJRS. */ /* $ Exceptions */ /* 1) This is an umbrella routine which contains declarations */ /* for its entry points. This routine should never be called */ /* directly. If it is, the error SPICE(BOGUSENTRY) will be */ /* signalled. */ /* See the entry points for discussions of the exceptions specific */ /* to those entry points. */ /* $ Files */ /* 1) This routine uses the EK scratch area, which employs a scratch */ /* DAS file. */ /* $ Particulars */ /* In the course of query resolution, the EK system builds a set of */ /* data structures called `join row sets' that represent the rows */ /* that satisfy the query constraints. These rows belong to a table */ /* formed by taking the Cartesian product of the tables in the FROM */ /* clause of the query. One join row set is formed for each */ /* conjunction of join constraints; the total number of join row sets */ /* is equal to the number of conjunctions of join constraints in */ /* the query. Join row sets are described below. */ /* This group of routines allows the EK system to view the rows */ /* matching a query as a sequence of vectors, where each vector is an */ /* n-tuple of row numbers designating rows in segments of the */ /* Cartesian product of tables specified in the input query. These */ /* vectors are called `row vectors'. Each row vector also points to */ /* a vector of segments that contain the rows represented by the row */ /* vector. */ /* These routines centralize the calculations needed to locate the */ /* nth row vector. */ /* Each join row set consists of: */ /* - a base address in the scratch area */ /* - a table count */ /* - a segment vector count */ /* - a set of segment vectors */ /* - a set of segment vector row vector base addresses */ /* (these are relative to the base of the join row set) */ /* - a set of segment vector row vector counts */ /* - a set of row vectors, augmented by offsets of their */ /* parent segment vectors (these offsets are at the */ /* end of each row vector) */ /* The layout of a join row set in the EK scratch area is shown */ /* below: */ /* +--------------------------------------------+ */ /* | join row set size | 1 element */ /* +--------------------------------------------+ */ /* | number of row vectors in join row set | 1 element */ /* +--------------------------------------------+ */ /* | table count (TC) | 1 element */ /* +--------------------------------------------+ */ /* | segment vector count (SVC) | 1 element */ /* +--------------------------------------------+ */ /* | segment vector 1 | TC elements */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | segment vector SVC | TC elements */ /* +--------------------------------------------+ */ /* | segment vector 1 row set base address | 1 element */ /* +--------------------------------------------+ */ /* | segment vector 1 row count (RC_1) | 1 element */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | segment vector SVC row set base address | 1 element */ /* +--------------------------------------------+ */ /* | segment vector SVC row count (RC_SVC) | 1 element */ /* +--------------------------------------------+ */ /* | Augmented row vectors for segment vector 1 | TC*(RC_1 + 1 ) */ /* +--------------------------------------------+ elements */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* |Augmented row vectors for segment vector SVC| TC*(RC_SVC + 1) */ /* +--------------------------------------------+ elements */ /* $ Examples */ /* 1) For a given join row set union, initialize the addressing */ /* routines, then look up row vectors. */ /* C */ /* C Tell the addressing routines where the join row set */ /* C union is. NJRS is the number of join row sets in */ /* C the union, BASES is an array of EK scratch area base */ /* C addresses of each join row set. A base address is */ /* C the predecessor of the first address actually */ /* C occupied by a join row set. */ /* C */ /* CALL ZZEKVSET ( NJRS, BASES ) */ /* C */ /* C Find the base address of the each row vector, as well */ /* C as the base address of the corresponding segment */ /* C vector. */ /* C */ /* DO I = 1, NJRS */ /* CALL EKVCAL ( I, RWVBAS, SGVBAS ) */ /* [Do something with the row vector....] */ /* END DO */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 06-SEP-2006 (NJB) */ /* Filled in Particulars section of header in entry point */ /* ZZEKVCAL. Changed previous version line's product from "Beta" */ /* to "SPICELIB" both here and in ZZEKVCAL. */ /* - SPICELIB Version 1.0.0, 28-SEP-1994 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* EK row vector address calculation */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Include Section: EK Join Row Set Parameters */ /* JRS$INC Version 1 17-SEP-1994 (NJB) */ /* Base-relative index of join row set size */ /* Index of row vector count */ /* Index of table count */ /* Index of segment vector count */ /* Base address of first segment vector */ /* End Include Section: EK Join Row Set Parameters */ /* Local variables */ /* Saved variables */ /* Standard SPICE error handling. */ /* Parameter adjustments */ if (bases) { } /* Function Body */ switch(n__) { case 1: goto L_zzekvset; case 2: goto L_zzekvcal; } if (return_()) { return 0; } else { chkin_("ZZEKVADR", (ftnlen)8); } /* Never come here. */ sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); chkout_("ZZEKVADR", (ftnlen)8); return 0; /* $Procedure ZZEKVSET ( Row vector address calculation set-up ) */ L_zzekvset: /* $ Abstract */ /* Given a union of EK join row sets, prepare EKVCAL to */ /* compute addresses of row vectors in that union. */ /* $ 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 */ /* UTILITY */ /* $ Declarations */ /* INTEGER NJRS */ /* INTEGER BASES ( * ) */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* NJRS I Number of join row sets in union. */ /* BASES I EK scratch area base addresses of join row sets. */ /* $ Detailed_Input */ /* NJRS is the number of join row sets in a join row set */ /* for which address calculations will be performed. */ /* BASES is an array of base addresses of the join row sets */ /* comprising the union. These addresses are the */ /* predecessors of the addresses actually occupied by */ /* the join row sets. There are NJRS base addresses */ /* in the array. The order in which addresses are */ /* listed in BASES determines the order of the union */ /* of the row vectors: the first row vector in the */ /* join row set whose base address is BASES(1) has */ /* index 1, and so on. The last row vector in the */ /* join row set whose base address is BASES(NJRS) has */ /* the highest index of any row vector in the union. */ /* $ Detailed_Output */ /* None. See $Particulars for a discussion of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the join row set count is less than 1 or greater than */ /* MXJRS, the error SPICE(INVALIDCOUNT) is signalled. */ /* 2) If any base address is less than zero or greater than TOP, */ /* the EK scratch area stack top, the error */ /* SPICE(BADADDRESS) is signalled. */ /* 3) If the table count for any join row set is less than 1 or */ /* greater than MXJOIN, the error SPICE(INVALIDCOUNT) is */ /* signalled. */ /* 4) If the table count for any join row set unequal to the count */ /* for the first join row set, the error SPICE(INVALIDCOUNT) is */ /* signalled. */ /* 5) If any join row set has a row vector count that is less than */ /* zero or greater than TOP, the EK scratch area stack top, the */ /* error SPICE(BADADDRESS) is signalled. */ /* 6) If any join row set has a segment vector count that is less */ /* than zero or greater than TOP, the EK scratch area stack top, */ /* the error SPICE(BADADDRESS) is signalled. */ /* $ Files */ /* 1) This routine uses the EK scratch area, which employs a scratch */ /* DAS file. */ /* $ Particulars */ /* This routine speeds up EK row vectors address calculations by */ /* centralizating the activities that need be performed only once */ /* for a series of address calculations for a given join row set */ /* union. */ /* $ Examples */ /* See the $Examples section of ZZEKVADR. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 28-SEP-1994 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* EK row vector address calculation */ /* -& */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKVSET", (ftnlen)8); } /* Validate join row set count. */ if (*njrs < 1 || *njrs > 200) { setmsg_("Number of join row sets was #; valid range is 1:#", (ftnlen) 49); errint_("#", njrs, (ftnlen)1); errint_("#", &c__200, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("ZZEKVSET", (ftnlen)8); return 0; } /* Validate the join row set bases. */ zzekstop_(&top); i__1 = *njrs; for (i__ = 1; i__ <= i__1; ++i__) { if (bases[i__ - 1] < 0 || bases[i__ - 1] > top) { setmsg_("Base address # was #; valid range is 1:#", (ftnlen)40); errint_("#", &i__, (ftnlen)1); errint_("#", &bases[i__ - 1], (ftnlen)1); errint_("#", &top, (ftnlen)1); sigerr_("SPICE(BADADDRESS)", (ftnlen)17); chkout_("ZZEKVSET", (ftnlen)8); return 0; } svbas[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("svbas", i__2, "zzekvadr_", (ftnlen)526)] = bases[i__ - 1]; } /* Validate and save the table count. It's an error for this */ /* count not to be identical for all of the join row sets in the */ /* union. */ addrss = bases[0] + 3; zzeksrd_(&addrss, &addrss, &ntabs); if (ntabs < 1 || ntabs > 10) { setmsg_("Table count for first join row set was #; valid range is 1:#" , (ftnlen)60); errint_("#", &ntabs, (ftnlen)1); errint_("#", &c__10, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("ZZEKVSET", (ftnlen)8); return 0; } i__1 = *njrs; for (i__ = 2; i__ <= i__1; ++i__) { addrss = bases[i__ - 1] + 3; zzeksrd_(&addrss, &addrss, &j); if (j != ntabs) { setmsg_("Join row set # contains # tables; first join row set co" "ntains # tables. These counts are supposed to match.", ( ftnlen)108); errint_("#", &i__, (ftnlen)1); errint_("#", &j, (ftnlen)1); errint_("#", &ntabs, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("ZZEKVSET", (ftnlen)8); return 0; } } /* Validate the row vector counts for each join row set. */ /* These counts must be in range. Save the start indices of */ /* the row vectors in each join row set. */ cleari_(&c__200, begidx); begidx[0] = 1; i__1 = *njrs; for (i__ = 1; i__ <= i__1; ++i__) { addrss = bases[i__ - 1] + 2; zzeksrd_(&addrss, &addrss, &j); if (j < 0 || j > top) { setmsg_("Join row set # has row count #; valid range is 0:#", ( ftnlen)50); errint_("#", &i__, (ftnlen)1); errint_("#", &j, (ftnlen)1); errint_("#", &top, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("ZZEKVSET", (ftnlen)8); return 0; } if (i__ < *njrs) { begidx[(i__2 = i__) < 200 && 0 <= i__2 ? i__2 : s_rnge("begidx", i__2, "zzekvadr_", (ftnlen)598)] = begidx[(i__3 = i__ - 1) < 200 && 0 <= i__3 ? i__3 : s_rnge("begidx", i__3, "zze" "kvadr_", (ftnlen)598)] + j; } } /* Retain the index of the last row vector. */ maxrwv = begidx[(i__1 = *njrs - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( "begidx", i__1, "zzekvadr_", (ftnlen)608)] + j; /* Save the base addresses of the row vectors in each join row set. */ /* Validate the segment vector counts while we're at it. */ i__1 = *njrs; for (i__ = 1; i__ <= i__1; ++i__) { addrss = bases[i__ - 1] + 4; zzeksrd_(&addrss, &addrss, &nsv); if (nsv < 0) { setmsg_("Join row set # has segment vector count #; count must b" "e non-negative.", (ftnlen)70); errint_("#", &i__, (ftnlen)1); errint_("#", &nsv, (ftnlen)1); errint_("#", &top, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("ZZEKVSET", (ftnlen)8); return 0; } rbas[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("rbas", i__2, "zzekvadr_", (ftnlen)633)] = addrss + nsv * (ntabs + 2); } /* Retain the count of join row sets in the union. */ svnjrs = *njrs; chkout_("ZZEKVSET", (ftnlen)8); return 0; /* $Procedure ZZEKVCAL ( Row vector address calculation ) */ L_zzekvcal: /* $ Abstract */ /* Find the EK scratch area base address of a row vector and the */ /* corresponding segment vector, where the row vector has a */ /* specified index within a union of join row sets. */ /* $ 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 */ /* UTILITY */ /* $ Declarations */ /* INTEGER RWVIDX */ /* INTEGER RWVBAS */ /* INTEGER SGVBAS */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* RWVIDX I Index of row vector. */ /* RWVBAS O EK scratch area base address of row vector. */ /* SGVBAS O Base address of parent segment vector. */ /* $ Detailed_Input */ /* RWVIDX is the index of a row vector in a join row set */ /* union. The union is presumed to have been */ /* specified by a call to ZZEKVSET. */ /* $ Detailed_Output */ /* RWVBAS is the EK scratch area base address of the row */ /* vector specified by RWVIDX. This address is */ /* the predecessor of the first address occupied by */ /* the row vector. The row vector occupies NTAB */ /* consecutive addresses, where NTAB is the common */ /* table count for all join row sets in the union */ /* containing the specified row vector. */ /* SGVBAS is the EK scratch area base address of the segment */ /* vector corresponding to the specified row vector. */ /* The segment vector also occupies NTAB consecutive */ /* addresses. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the input index is less than 1 or greater than */ /* the highest index in the join row set union being addressed, */ /* the error SPICE(INVALIDINDEX) is signalled. */ /* $ Files */ /* 1) This routine uses the EK scratch area, which employs a scratch */ /* DAS file. */ /* $ Particulars */ /* See header of umbrella routine ZZEKVADR. */ /* $ Examples */ /* See the $Examples section of ZZEKVADR. */ /* $ Restrictions */ /* 1) ZZEKVSET must be called before this routine is called for the */ /* first time. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 06-SEP-2006 (NJB) */ /* Filled in Particulars section of header. Changed */ /* previous version line's product from "Beta" to "SPICELIB." */ /* - SPICELIB Version 1.0.0, 22-SEP-1994 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* EK row vector address calculation */ /* -& */ /* Use discovery check-in for speed; don't check RETURN. */ /* If the index is out of range, that's an error. */ if (*rwvidx < 1 || *rwvidx > maxrwv) { chkin_("ZZEKVCAL", (ftnlen)8); setmsg_("Row vector index was #; valid range is 0:#", (ftnlen)42); errint_("#", rwvidx, (ftnlen)1); errint_("#", &maxrwv, (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKVCAL", (ftnlen)8); return 0; } /* Identify the join row set containing the indicated row. Our error */ /* check guarantees a non-zero result. */ jrsidx = lstlei_(rwvidx, &svnjrs, begidx); /* Compute the offset of the indicated row vector relative to the */ /* first row vector in the parent join row set. This offset is one */ /* less than the relative index of the row vector, multiplied by */ /* the augmented row vector size. */ reloff = (*rwvidx - begidx[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("begidx", i__1, "zzekvadr_", (ftnlen)814)]) * (ntabs + 1); /* Find the base address of the row vector. */ *rwvbas = rbas[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( "rbas", i__1, "zzekvadr_", (ftnlen)819)] + reloff; /* Compute the base address of the parent segment vector. The base- */ /* relative address of the segment vector is stored at the end of the */ /* row vector. */ i__1 = *rwvbas + ntabs + 1; i__2 = *rwvbas + ntabs + 1; zzeksrd_(&i__1, &i__2, sgvbas); *sgvbas = svbas[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( "svbas", i__1, "zzekvadr_", (ftnlen)828)] + *sgvbas; return 0; } /* zzekvadr_ */
/* $Procedure ZZEKTRIT ( EK tree, initialize ) */ /* Subroutine */ int zzektrit_(integer *handle, integer *tree) { integer base, page[256]; extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, integer *), zzekpgwi_(integer *, integer *, integer *); integer p; extern /* Subroutine */ int chkin_(char *, ftnlen), cleari_(integer *, integer *), chkout_(char *, ftnlen); extern logical return_(void); /* $ Abstract */ /* Initialize an EK tree, returning the root of the tree. */ /* $ 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 O Root of tree. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* $ Detailed_Output */ /* TREE is the root node number of the tree created by */ /* this routine. The root node number is used by the */ /* EK tree routines to identify the tree. */ /* $ 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. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine is used to create a new, empty EK tree. The */ /* tree has a root node, but no keys are contained in the root. */ /* The metadata area of the tree is initialized. */ /* $ Examples */ /* See EKBSEG. */ /* $ 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, 20-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKTRIT", (ftnlen)8); } /* Start out by allocating a DAS integer page. We'll write the root */ /* node out to this page. */ zzekpgal_(handle, &c__3, &p, &base); page[0] = 1; page[1] = 1; page[2] = 0; page[4] = 0; page[3] = 1; /* Set all keys to zero; set all child and data pointers to null. */ cleari_(&c__82, &page[5]); cleari_(&c__82, &page[172]); cleari_(&c__83, &page[88]); /* Write out the page. */ zzekpgwi_(handle, &p, page); /* The identifier we return is just the page number of the tree's */ /* root. */ *tree = p; chkout_("ZZEKTRIT", (ftnlen)8); return 0; } /* zzektrit_ */
/* $Procedure COMMNT ( Comment utility program ) */ /* Main program */ MAIN__(void) { /* Initialized data */ static logical insbln = TRUE_; static char maintl[20] = "COMMNT Options "; static char mainvl[20*5] = "QUIT " "ADD_COMMENTS " "READ_COMMENTS " "EXTRACT_COMMENTS " "DELETE_COMMENTS " " "; static char maintx[40*5] = "Quit. " "Add comments to a binary file. " "Read the comments in" " a binary file. " "Extract comments from a binary file. " "Delete the comments in a binary file. "; static char mainnm[1*5] = "Q" "A" "R" "E" "D"; /* System generated locals */ address a__1[3]; integer i__1[3], i__2, i__3, i__4, i__5; cllist cl__1; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, char **, integer *, integer *, ftnlen); integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, ftnlen, ftnlen), f_clos(cllist *); /* Local variables */ static char arch[3]; static logical done; static char line[1000]; static logical more; static integer iopt; static char type__[4]; static integer i__; extern /* Subroutine */ int dasdc_(integer *); extern integer cardi_(integer *); static integer r__; extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *, ftnlen, ftnlen), chkin_(char *, ftnlen), spcec_(integer *, integer *), spcdc_(integer *), errch_(char *, char *, ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), reset_(void); extern integer rtrim_(char *, ftnlen); extern logical failed_(void); extern /* Subroutine */ int dafhof_(integer *); static integer handle; extern /* Subroutine */ int dafcls_(integer *), dasacu_(integer *, char *, char *, logical *, integer *, ftnlen, ftnlen), cleari_(integer *, integer *), delfil_(char *, ftnlen), dasecu_(integer *, integer * , logical *), scardi_(integer *, integer *), dashof_(integer *); static logical fileok; extern /* Subroutine */ int clcomm_(void), getfat_(char *, char *, char *, ftnlen, ftnlen, ftnlen), cnfirm_(char *, logical *, ftnlen); static char fnmtbl[128*2], messag[1000], errmsg[320], messgs[1000*7], option[20], prmtbl[80*2], statbl[3*2]; extern logical exists_(char *, ftnlen); static integer comlun; static char status[1000*2]; static integer numfnm; static char prmpts[80*2]; static integer numopn, opnset[7], tblidx[2]; static logical comnts, contnu, ndfnms, tryagn; extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen), erract_(char *, char *, ftnlen, ftnlen), errprt_(char *, char *, ftnlen, ftnlen), tostdo_(char *, ftnlen), ssizei_(integer *, integer *), getopt_(char *, integer *, char *, char *, integer *, ftnlen, ftnlen, ftnlen), getfnm_(char *, char *, char *, logical * , char *, ftnlen, ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen) , sigerr_(char *, ftnlen), txtopr_(char *, integer *, ftnlen), dafopw_(char *, integer *, ftnlen), dasopw_(char *, integer *, ftnlen), dascls_(integer *), dafopr_(char *, integer *, ftnlen), spcrfl_(integer *, char *, logical *, ftnlen), spcrnl_(char *, logical *, ftnlen), dasopr_(char *, integer *, ftnlen), txtopn_( char *, integer *, ftnlen), chkout_(char *, ftnlen); static logical eoc; static char tkv[12]; /* $ Abstract */ /* NAIF Toolkit utility program for adding, reading, extracting, */ /* and deleting comments from a binary file. */ /* $ 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 */ /* SPC */ /* DAS */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* K.R. Gehringer (JPL) */ /* J.E. McLean (JPL) */ /* M.J. Spencer (JPL) */ /* $ Version */ /* - Version 6.0.1, 08-MAY-2001 (BVS) */ /* Increased LINLEN from 255 to 1000 to make it consistent */ /* with SPICELIB's SPC* and SUPPORT's DAF* internal line sizes. */ /* - Version 5.0.1, 21-JUL-1997 (WLT) */ /* Modified the banner at start up so that the version of the */ /* toolkit used to link COMMNT will be displayed. */ /* In addition all WRITE statements were replaced by calls to */ /* TOSTDO. */ /* - Version 5.0.0, 05-MAY-1994 (KRG) */ /* Modified the program to use the new file type identification */ /* capability that was added to spicelib. No file type menu is */ /* necessary now, as the file type is determined during the */ /* execution of the program. */ /* The prompts for the begin and end markers used to extract a */ /* subset of text lines from an input comment file which were then */ /* placed into the comment area of a SPICE binary kernel file have */ /* been removed. The entire input comment file is now placed into */ /* the comment area of the binary kernel file. This change */ /* simplifies the user interaction with the program. */ /* Added support for the new PCK binary kernel files. */ /* If an error occurs during the extraction of comments to a file, */ /* the file that was being created is deleted. We cannot know */ /* whether the file had been successfully created before the error */ /* occurred. */ /* - Version 4.0.0, 11-DEC-1992 (KRG) */ /* Added code to support the E-Kernel, and redesigned the */ /* user interface. */ /* - Version 3.1.0, 19-NOV-1991 (MJS) */ /* Variable QUIT initialized to FALSE. */ /* - Version 3.0.1, 10-AUG-1991 (CHA) (NJB) */ /* Updated comments to reflect status as a Toolkit */ /* utility program. Message indicating that no comments */ /* were found in the specified file was changed to include */ /* the file name. */ /* - Version 2.0.0, 28-JUN-1991 (JEM) */ /* The option to read the comments from the comment */ /* area of a binary SPK or CK was added to the menu. */ /* - Version 1.0.0, 05-APR-1991 (JEM) */ /* -& */ /* SPICELIB functions */ /* Parameters */ /* Set the version of the comment program. This should be updated */ /* every time a change is made, and it should agree with the */ /* version number in the header. */ /* Set a value for the logical unit which represents the standard */ /* output device, commonly a terminal. A value of 6 is widely used, */ /* but the Fortran standard does not specify a value, so it may be */ /* different for different Fortran implementations. */ /* Lower bound for a SPICELIB CELL data structure. */ /* Maximum number of open binary files allowed. */ /* Set a value for a replacement marker. */ /* Set a value for a filename prompt. */ /* File types */ /* Set a value for the length of a text line. */ /* Set a value for the length of an error message. */ /* Set a value for the length of a filename. */ /* Set a length for the prompts in the prompt table. */ /* Set a length for the status of a file: 'OLD' or 'NEW'. */ /* Set the length for the architecture of a file. */ /* Set the length for the type of a file. */ /* Set a length for the option values. */ /* Set a length for the title of a menu. */ /* Set a length for an option name (what is typed to select it) */ /* for a menu. */ /* Set the length of the text description of an option on a menu. */ /* The number of options available on the main menu. */ /* Set up some mnemonics for indexing the prompts in the prompt */ /* table. */ /* Set the maximum size of the filename table: this must be the */ /* number of distinct ``types'' of files that the program may */ /* require. */ /* Set up some mnemonics for indexing the messages in the message */ /* table. */ /* Set the maximum size of the message table: There should be a */ /* message for each ``type'' of action that the program can take. */ /* Set up some mnemonics for the OK and not OK status messages. */ /* Set the maximum number of status messages that are available. */ /* We need to have TKVLEN characters to hold the current version */ /* of the toolkit. */ /* Variables */ /* We want to insert a blank line between additions if there are */ /* already comments in the binary file. We indicate this by giving */ /* the variable INSBLN the value .TRUE.. */ /* Define the main menu title ... */ /* Define the main menu option values ... */ /* Define the main menu descriptive text for each option ... */ /* Define the main menu option names ... */ /* Register the COMMNT main program with the SPICELIB error handler. */ chkin_("COMMNT", (ftnlen)6); clcomm_(); tkvrsn_("TOOLKIT", tkv, (ftnlen)7, (ftnlen)12); r__ = rtrim_(tkv, (ftnlen)12); /* Set the error action to 'RETURN'. We don't want the program */ /* to abort if an error is signalled. We check FAILED where */ /* necessary. If an error is signalled, we'll just handle the */ /* error, display an appropriate message, then call RESET at the */ /* end of the loop to continue. */ erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6); /* Set the error messages that we want to have displayed. We will */ /* diaplay the SPICELIB short and long error messages. This is done */ /* to ensure that some sort of an error message is displayed if an */ /* error occurs. In several places, long error messages are not set, */ /* so if only the long error messages were displayed, it would be */ /* possible to have an error signalled and not see any error */ /* information. This is not a very useful thing. */ errprt_("SET", "NONE, SHORT, LONG, TRACEBACK", (ftnlen)3, (ftnlen)28); /* Set up the prompt table for the different types of files. */ s_copy(prmtbl + 80, "Enter the name of the comment file to be #.", ( ftnlen)80, (ftnlen)43); s_copy(prmtbl, "Enter the name of the binary file.", (ftnlen)80, (ftnlen) 34); /* Set up the message table for the different ``types'' of */ /* operations. The message table contains generic messages which will */ /* have their missing parts filled in after the option and file type */ /* havve been selected. */ s_copy(messgs, "Reading the comment area of the # file.", (ftnlen)1000, ( ftnlen)39); s_copy(messgs + 1000, "Adding comments to the # file.", (ftnlen)1000, ( ftnlen)30); s_copy(messgs + 2000, "Extracting comments from the # file.", (ftnlen) 1000, (ftnlen)36); s_copy(messgs + 3000, "Deleting the comment area of # file.", (ftnlen) 1000, (ftnlen)36); s_copy(messgs + 4000, "Quitting the program.", (ftnlen)1000, (ftnlen)21); s_copy(messgs + 5000, "The comments were successfully #.", (ftnlen)1000, ( ftnlen)33); s_copy(messgs + 6000, "The comments were NOT successfully #.", (ftnlen) 1000, (ftnlen)37); /* Display a brief commercial with the name of the program and the */ /* version. */ s_copy(line, " Welcome to COMMNT Version: #", (ftnlen)1000, (ftnlen)31); repmc_(line, "#", "6.0.1", line, (ftnlen)1000, (ftnlen)1, (ftnlen)5, ( ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); /* Writing concatenation */ i__1[0] = 23, a__1[0] = " (Spice Toolkit "; i__1[1] = r__, a__1[1] = tkv; i__1[2] = 1, a__1[2] = ")"; s_cat(line, a__1, i__1, &c__3, (ftnlen)1000); tostdo_(line, (ftnlen)1000); tostdo_(" ", (ftnlen)1); /* Initialize the CELL oriented set for collecting open DAF or DAS */ /* files in the event of an error. */ ssizei_(&c__1, opnset); /* While there is still more to do ... */ done = FALSE_; while(! done) { /* We initialize a few things here, so that they get reset for */ /* every trip through the loop. */ /* Initialize the logical flags that we use. */ comnts = FALSE_; contnu = TRUE_; eoc = FALSE_; ndfnms = FALSE_; /* Initialize the filename table, ... */ s_copy(fnmtbl, " ", (ftnlen)128, (ftnlen)1); s_copy(fnmtbl + 128, " ", (ftnlen)128, (ftnlen)1); /* the file status table, ... */ s_copy(statbl, " ", (ftnlen)3, (ftnlen)1); s_copy(statbl + 3, " ", (ftnlen)3, (ftnlen)1); /* the table indices, ... */ tblidx[0] = 0; tblidx[1] = 0; /* set the number of file names to zero, ... */ numfnm = 0; /* the prompts in the prompt table, ... */ s_copy(prmpts, " ", (ftnlen)80, (ftnlen)1); s_copy(prmpts + 80, " ", (ftnlen)80, (ftnlen)1); /* the message, and the option. */ s_copy(messag, " ", (ftnlen)1000, (ftnlen)1); s_copy(option, " ", (ftnlen)20, (ftnlen)1); /* Set the status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)1000); /* Get the option to be performed from the main menu. */ getopt_(maintl, &c__5, mainnm, maintx, &iopt, (ftnlen)20, (ftnlen)1, ( ftnlen)40); s_copy(option, mainvl + ((i__2 = iopt - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("mainvl", i__2, "commnt_", (ftnlen)502)) * 20, (ftnlen) 20, (ftnlen)20); /* Set up the messages and other information for the option */ /* selected. */ if (contnu) { if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) { ndfnms = TRUE_; numfnm = 2; s_copy(messag, messgs + 1000, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 2; s_copy(prmpts, prmtbl + 80, (ftnlen)80, (ftnlen)80); repmc_(prmpts, "#", "added", prmpts, (ftnlen)80, (ftnlen)1, ( ftnlen)5, (ftnlen)80); s_copy(statbl + 3, "OLD", (ftnlen)3, (ftnlen)3); tblidx[1] = 1; s_copy(prmpts + 80, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "added", status, (ftnlen)1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "added", status + 1000, (ftnlen) 1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000); } else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13) == 0) { ndfnms = TRUE_; numfnm = 1; s_copy(messag, messgs, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 1; s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "read", status, (ftnlen)1000, (ftnlen)1, ( ftnlen)4, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "read", status + 1000, (ftnlen) 1000, (ftnlen)1, (ftnlen)4, (ftnlen)1000); } else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen) 16) == 0) { ndfnms = TRUE_; numfnm = 2; s_copy(messag, messgs + 2000, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 1; s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); tblidx[1] = 2; s_copy(prmpts + 80, prmtbl + 80, (ftnlen)80, (ftnlen)80); repmc_(prmpts + 80, "#", "created", prmpts + 80, (ftnlen)80, ( ftnlen)1, (ftnlen)7, (ftnlen)80); s_copy(statbl + 3, "NEW", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "extracted", status, (ftnlen)1000, ( ftnlen)1, (ftnlen)9, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "extracted", status + 1000, ( ftnlen)1000, (ftnlen)1, (ftnlen)9, (ftnlen)1000); } else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen) 15) == 0) { ndfnms = TRUE_; numfnm = 1; s_copy(messag, messgs + 3000, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 1; s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "deleted", status, (ftnlen)1000, (ftnlen) 1, (ftnlen)7, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "deleted", status + 1000, (ftnlen) 1000, (ftnlen)1, (ftnlen)7, (ftnlen)1000); } else if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) { s_copy(messag, messgs + 4000, (ftnlen)1000, (ftnlen)1000); } } /* Collect any filenames that we may need. */ if (contnu && ndfnms) { /* we always need at least one filename if we get to here. */ i__ = 1; more = TRUE_; while(more) { fileok = FALSE_; tryagn = TRUE_; while(tryagn) { tostdo_(" ", (ftnlen)1); tostdo_(prmpts + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("prmpts", i__2, "commnt_", (ftnlen) 614)) * 80, (ftnlen)80); tostdo_(" ", (ftnlen)1); getfnm_("Filename? ", statbl + ((i__3 = tblidx[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("tblidx" , i__2, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <= i__3 ? i__3 : s_rnge("statbl", i__3, "commnt_", ( ftnlen)617)) * 3, fnmtbl + (((i__5 = tblidx[(i__4 = i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("tbl" "idx", i__4, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <= i__5 ? i__5 : s_rnge("fnmtbl", i__5, "commn" "t_", (ftnlen)617)) << 7), &fileok, errmsg, ( ftnlen)10, (ftnlen)3, (ftnlen)128, (ftnlen)320); /* If the filename is OK, increment the filename index */ /* and leave the try again loop. Otherwise, write out the */ /* error message, and give the opportunity to go around */ /* again. */ if (fileok) { ++i__; tryagn = FALSE_; } else { tostdo_(" ", (ftnlen)1); tostdo_(errmsg, (ftnlen)320); tostdo_(" ", (ftnlen)1); cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20); if (! tryagn) { contnu = FALSE_; more = FALSE_; } } } if (i__ > numfnm) { more = FALSE_; } } } /* Get the file architecture and type. */ if (contnu && ndfnms) { getfat_(fnmtbl, arch, type__, (ftnlen)128, (ftnlen)3, (ftnlen)4); if (failed_()) { contnu = FALSE_; } } /* Check to see that we got back a valid architecture and type. */ if (contnu && ndfnms) { if (s_cmp(arch, "?", (ftnlen)3, (ftnlen)1) == 0 || s_cmp(type__, "?", (ftnlen)4, (ftnlen)1) == 0) { contnu = FALSE_; setmsg_("The architecture and type of the binary file '#' co" "uld not be determined. A common error is to give the" " name of a text file instead of the name of a binary" " file.", (ftnlen)161); errch_("#", fnmtbl, (ftnlen)1, (ftnlen)128); sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20); } } /* Customize the message. We know we can do this, because we */ /* need files, and so we don't have the QUIT message. */ if (contnu && ndfnms) { repmc_(messag, "#", type__, messag, (ftnlen)1000, (ftnlen)1, ( ftnlen)4, (ftnlen)1000); } /* Process the option that was selected so long ago. */ if (contnu) { if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); tostdo_(" ", (ftnlen)1); done = TRUE_; } else if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1, (ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(line, (ftnlen)1000); /* Open the text file which contains the comments to be */ /* added to the binary file. */ txtopr_(fnmtbl + 128, &comlun, (ftnlen)128); if (! failed_()) { if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen) 1); dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen) 1); dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen) 1); dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dasopw_(fnmtbl, &handle, (ftnlen)128); dasacu_(&comlun, " ", " ", &insbln, &handle, (ftnlen) 1, (ftnlen)1); dascls_(&handle); } /* Close the comment file. */ cl__1.cerr = 0; cl__1.cunit = comlun; cl__1.csta = 0; f_clos(&cl__1); } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); tostdo_(" ", (ftnlen)1); if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); /* The comments are read a line at a time and displayed */ /* on the screen. */ spcrfl_(&handle, line, &eoc, (ftnlen)1000); if (! failed_()) { if (eoc) { tostdo_("There were no comments found in the fil" "e.", (ftnlen)41); } while(! eoc && ! failed_()) { tostdo_(line, (ftnlen)1000); spcrnl_(line, &eoc, (ftnlen)1000); } } dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); /* The comments are read a line at a time and displayed */ /* on the screen. */ spcrfl_(&handle, line, &eoc, (ftnlen)1000); if (! failed_()) { if (eoc) { tostdo_("There were no commentfound in the file.", (ftnlen)39); } while(! eoc && ! failed_()) { tostdo_(line, (ftnlen)1000); spcrnl_(line, &eoc, (ftnlen)1000); } } dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); /* The comments are read a line at a time and displayed */ /* on the screen. */ spcrfl_(&handle, line, &eoc, (ftnlen)1000); if (! failed_()) { if (eoc) { tostdo_("There were no comments found in the fil" "e.", (ftnlen)41); } while(! eoc && ! failed_()) { tostdo_(line, (ftnlen)1000); spcrnl_(line, &eoc, (ftnlen)1000); } } dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dasopr_(fnmtbl, &handle, (ftnlen)128); dasecu_(&handle, &c__6, &comnts); dascls_(&handle); if (! comnts) { s_copy(line, "There were no comments found in the fi" "le.", (ftnlen)1000, (ftnlen)41); tostdo_(line, (ftnlen)1000); } } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen) 16) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1, (ftnlen)128, (ftnlen)1000); tostdo_(line, (ftnlen)1000); /* Open the text file. */ txtopn_(fnmtbl + 128, &comlun, (ftnlen)128); if (! failed_()) { if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); spcec_(&handle, &comlun); dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); spcec_(&handle, &comlun); dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); spcec_(&handle, &comlun); dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dasopr_(fnmtbl, &handle, (ftnlen)128); dasecu_(&handle, &comlun, &comnts); dascls_(&handle); if (! comnts) { s_copy(line, "There were no comments found in th" "e file.", (ftnlen)1000, (ftnlen)41); tostdo_(line, (ftnlen)1000); } } /* Close the text file that we opened. */ cl__1.cerr = 0; cl__1.cunit = comlun; cl__1.csta = 0; f_clos(&cl__1); } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen) 15) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcdc_(&handle); dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcdc_(&handle); dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcdc_(&handle); dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dasopw_(fnmtbl, &handle, (ftnlen)128); dasdc_(&handle); dascls_(&handle); } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } } /* If anything failed, close any binary files that might still be */ /* open and reset the error handling before getting the next */ /* option. */ if (failed_()) { /* Before we can attempt to perform any clean up actions if an */ /* error occurred, we need to reset the SPICELIB error handling */ /* mechanism so that we can call the SPICELIB routines that we */ /* need to. */ reset_(); /* Clear out any binary file handles in the open set, OPNSET. */ scardi_(&c__0, opnset); cleari_(&c__1, &opnset[6]); /* Get the handles for any DAF files which may still be open. */ dafhof_(opnset); numopn = cardi_(opnset); if (numopn > 0) { i__2 = numopn; for (i__ = 1; i__ <= i__2; ++i__) { dafcls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 : s_rnge("opnset", i__3, "commnt_", (ftnlen)1100)]) ; } } /* Clear out any binary file handles in the open set, OPNSET. */ scardi_(&c__0, opnset); cleari_(&c__1, &opnset[6]); /* Get the handles for any DAS files which may still be open. */ dashof_(opnset); numopn = cardi_(opnset); if (numopn > 0) { i__2 = numopn; for (i__ = 1; i__ <= i__2; ++i__) { dascls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 : s_rnge("opnset", i__3, "commnt_", (ftnlen)1121)]) ; } } /* If there was an error and we were extracting comments to a */ /* file, then we should delete the file that was created, */ /* because we do not know whether the extraction was completed */ /* successfully. */ if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)16) == 0) { if (exists_(fnmtbl + 128, (ftnlen)128)) { delfil_(fnmtbl + 128, (ftnlen)128); } } /* Finally, reset the error handling, and go get the next */ /* option. This is just to be sure. */ reset_(); } } chkout_("COMMNT", (ftnlen)6); return 0; } /* MAIN__ */