/* * GO: sets the tree cursors on each term in terms, processes the terms by advancing * the terms cursors and storing the partial * results and lastly calculates the top results * @param results, the priority queue containing the top results * @param limit, number of results in the priority queue */ void FTSSearch::go(Results* results, unsigned limit ) { vector< shared_ptr<BtreeCursor> > cursors; for ( unsigned i = 0; i < _query.getTerms().size(); i++ ) { const string& term = _query.getTerms()[i]; BSONObj min = FTSIndexFormat::getIndexKey( MAX_WEIGHT, term, _indexPrefix ); BSONObj max = FTSIndexFormat::getIndexKey( 0, term, _indexPrefix ); shared_ptr<BtreeCursor> c( BtreeCursor::make( _ns, _id, min, max, true, -1 ) ); cursors.push_back( c ); } while ( !inShutdown() ) { bool gotAny = false; for ( unsigned i = 0; i < cursors.size(); i++ ) { if ( cursors[i]->eof() ) continue; gotAny = true; _process( cursors[i].get() ); cursors[i]->advance(); } if ( !gotAny ) break; RARELY killCurrentOp.checkForInterrupt(); } // priority queue using a compare that grabs the lowest of two ScoredLocations by score. for ( Scores::iterator i = _scores.begin(); i != _scores.end(); ++i ) { if ( i->second < 0 ) continue; // priority queue if ( results->size() < limit ) { // case a: queue unfilled if ( !_ok( i->first ) ) continue; results->push( ScoredLocation( i->first, i->second ) ); } else if ( i->second > results->top().score ) { // case b: queue filled if ( !_ok( i->first ) ) continue; results->pop(); results->push( ScoredLocation( i->first, i->second ) ); } else { // else do nothing (case c) } } }
ADIobj adix_prs_cmdlist( ADIobj pstream, char *termlist, int *choice, ADIstatus status ) { int len; ADIlogical more = ADI__true; /* More statements in list? */ ADIobj robj = ADI__nullid; /* Returned object */ ADIobj state; /* Parsed statement */ char *tcur; /* Cursor over terminator list */ ADIobj *ipoint = &robj; /* Check inherited status on entry */ _chk_stat_ret(ADI__nullid); /* While more statements */ while ( _ok(status) && more ) { /* If statement starts with a symbol, test against terminal list */ if ( ADIcurrentToken(pstream,status) == TOK__SYM ) { tcur = termlist; *choice = 1; while ( more && _ok(status) && (*tcur=='|') ) { len = 0; tcur++; while ( (tcur[len] != '|') && tcur[len] ) len++; if ( !strncmp(_strm_data(pstream)->ctok.dat,tcur,len) ) more = ADI__false; else (*choice)++; tcur += len; } } if ( more ) { state = adix_prs_cmd( pstream, status ); ADInextToken( pstream, status ); if ( _valid_q(state) ) lstx_inscel( state, &ipoint, status ); } } /* Use the null list to represent the null statement list */ if ( _null_q(robj) ) robj = adix_clone( ADIcvNulCons, status ); return robj; }
ADIobj adix_prs_while( int narg, ADIobj args[], ADIstatus status ) { ADIobj pstream = args[0]; int choice; ADIobj robj = ADI__nullid; /* Returned object */ ADIobj action; /* Action procedure */ ADIobj test; /* The WHILE test expression */ /* Skip the command name */ ADInextToken( pstream, status ); ADImatchToken( pstream, TOK__LPAREN, status ); test = ADIparseExpInt( pstream, ADI__nullid, 1, status ); ADImatchToken( pstream, TOK__RPAREN, status ); ADImatchToken( pstream, TOK__END, status ); /* Action list */ action = adix_prs_cmdlist( pstream, "|end", &choice, status ); if ( _ok(status) ) { ADInextToken( pstream, status ); /* Match the "end" */ /* Construct argument list */ robj = lstx_new2( test, action, status ); } return ADIetnNew( adix_clone( K_While, status ), robj, status ); }
static NodeRef ParsePrimary( char **spec, int *status ) { NodeRef node = NIL; if ( !_ok(status) ) node = NIL; else if ( curtok == TOK_ID ) { node = NewNode( TOK_ID, curid, NIL, NIL, status ); NextToken( spec, status ); } else if ( curtok == TOK_OPAREN ) { NextToken( spec, status ); node = ParseExpr( spec, status ); if ( curtok == TOK_CPAREN ) NextToken( spec, status ); else { *status = SAI__ERROR; ems_rep_c( " ", "Syntax error - right parenthesis expected", status ); } } else { *status = SAI__ERROR; ems_rep_c( " ", "Unexpected token in model specification", status ); } return node; }
static void FlatShow( int term, int *status ) { int aterm = term; int i,word,j; if ( !_ok(status) ) return; do { for( i=0; i<terms[aterm].len; i++ ) { if ( i ) putchar('*'); word = terms[aterm].elem[i]-1; for(j=0; j<modlen[word];j++) putchar(modpos[word][j]); } if ( terms[aterm].next != NullTerm ) { if ( terms[aterm].t == TOK_PLUS ) printf( "+" ); else printf( "-" ); } aterm = terms[aterm].next; } while ( aterm != NullTerm ); printf( "\n" ); }
ADIobj adix_prs_defproc( int narg, ADIobj args[], ADIstatus status ) { ADIobj pstream = args[0]; ADIobj actions; int choice; ADIobj defn; ADIobj robj = ADI__nullid; /* Skip the DEFPROC keyword */ ADInextToken( pstream, status ); /* Get the definition expression */ defn = ADIparseExpInt( pstream, ADI__nullid, 1, status ); /* Check it */ if ( _ok(status) ) { if ( ! _etn_q(defn) ) { adic_setecs( ADI__SYNTAX, "Invalid procedure definition", status ); } else { actions = adix_prs_cmdlist( pstream, "|endproc", &choice, status ); ADInextToken( pstream, status ); robj = ADIetnNew( adix_clone( K_DefProc, status ), lstx_new2( defn, actions, status ), status ); } } /* Create the expression node */ return robj; }
void _int_is(char* test_name, int i1, int i2, char *file, int linenum) { _ok(test_name, (i1==i2), file, linenum, ""); if (i1!=i2) { printf("# got: %d\n", i1); printf("# expected: %d\n", i2); } }
int rec_locate_fns( const struct HAN *han, const char **fns ) { /*+ */ /* Name: */ /* rec_locate_fns */ /* Purpose: */ /* Obtain a pointer to the file name string for a container file. */ /* Invocation: */ /* rec_locate_fns( han, fns ) */ /* Description: */ /* This function returns a pointer to a file name string for an HDS */ /* container file. A handle to a record in the file must be supplied. */ /* Parameters: */ /* const struct HAN *han */ /* Pointer to a HAN structure containing a handle for any record in */ /* the container file. */ /* const char **fns */ /* Pointer to a char pointer which will be set to point at a */ /* null-terminated file name string for the container file. This */ /* string must not be altered by the calling routine. A null pointer */ /* value will be returned under error conditions. */ /* Returned Value: */ /* int rec_locate_fns */ /* The global status value current on exit. */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* {@enter_new_authors_here@} */ /* History: */ /* 24-APR-1991 (RFWS): */ /* Added prologue and error handling and tidied. */ /* {@enter_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /*. */ /* Set an initial null value for the returned pointer. */ *fns = NULL; /* Check the inherited global status. */ if ( !_ok( hds_gl_status ) ) return hds_gl_status; /* Return a pointer to the File Name String in the File Control Vector. */ *fns = rec_ga_fcv[ han->slot ].name; /* Return the current global status value. */ return hds_gl_status; }
void rec_mark_delete( const struct HAN *han, int *status ) { /*+ */ /* Name: */ /* rec_mark_delete */ /* Purpose: */ /* Mark an HDS container file for deletion. */ /* Invocation: */ /* rec_mark_delete( han, status ) */ /* Description: */ /* This function marks an HDS container file so that it will be deleted */ /* when it is closed (but note that this function does not itslf close */ /* the file). A single invocation is sufficient to ensure that the file */ /* will eventually be deleted; subsequent invocations have no further */ /* effect. */ /* Parameters: */ /* const struct HAN *han */ /* Pointer to a HAN structure containing a handle to any record in */ /* the file. */ /* int *status */ /* Pointer to the inherited global status. */ /* Returned Value: */ /* void */ /* Copyright: */ /* Copyright (C) 1992 Science & Engineering Research Council */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* {@enter_new_authors_here@} */ /* History: */ /* 23-SEP-1992 (RFWS): */ /* Original version. */ /* {@enter_further_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /*. */ /* Check the inherited global status. */ if ( !_ok( *status ) ) return; /* Set the deletion flag in the file control vector. */ rec_ga_fcv[ han->slot ].dele = 1; /* Exit the routine. */ return; }
static void TreeFree( NodeRef node, int *status ) { if ( !_ok(status) || (! node) ) return; if ( node->lhs ) TreeFree( node->lhs, status ); if ( node->rhs ) TreeFree( node->rhs, status ); free( node ); }
/* * Parse a single statement. The token which signifies the end of valid statement * (an end-of-line or semicolon) is not matched by this routine. Null statements * are ignored, and the null identifier returned. * */ ADIobj adix_prs_cmd( ADIobj pstream, ADIstatus status ) { ADIobj cbind; ADItokenType ctok; ADIobj name; ADIobj rval = ADI__nullid; /* IF command starts with a symbol, look for a command binding */ if ( ADIcurrentToken(pstream,status) == TOK__SYM ) { name = prsx_symname( pstream, status ); cbind = ADIsymFind( name, -1, ADI__true, ADI__command_sb, status ); /* Located a command symbol? */ if ( _valid_q(cbind) ) { /* Invoke parser procedure with stream as argument */ rval = adix_exemth( ADI__nullid, _mthd_exec(_sbind_defn(cbind)), 1, &pstream, status ); } else rval = ADIparseExpInt( pstream, ADI__nullid, 1, status ); } else rval = ADIparseExpInt( pstream, ADI__nullid, 1, status ); /* Check for garbage following statement */ if ( _valid_q(rval) && _ok(status) ) { ctok = ADIcurrentToken(pstream,status); if ( ctok != TOK__END && ctok != TOK__SEMICOLON ) { char *tstr; int tlen; ADIdescribeToken( ctok, &tstr, &tlen ); ADIparseError( pstream, ADI__SYNTAX, "Error reading statement - %*s found where semi-colon or end of line expected", status, tlen, tstr ); } } /* == TOK__END ADInextToken( pstream, status ); */ return rval; }
static int GetNewTerm( int *status ) { int aterm = NullTerm; int i; if ( !_ok(status) ) return aterm; for( i=0; i<MAXTERM; i++ ) if ( ! terms[i].len ) { terms[i].next = NullTerm; aterm = i; terms[i].len = 1; break; } return aterm; }
static NodeRef NewNode( LegalToken t, int data, NodeRef lhs, NodeRef rhs, int *status ) { NodeRef node; if ( !_ok(status) ) return NIL; node = (NodeRef) malloc( sizeof(Node) ); node->t = t; node->lhs = lhs; node->rhs = rhs; node->data = data; return node; }
static NodeRef ParseTerm( char **spec, int *status ) { NodeRef node = NIL; node = ParsePrimary( spec, status ); while ( (curtok == TOK_TIMES) && _ok(status) ) { NextToken( spec, status ); node = NewNode( TOK_TIMES, 0, node, ParsePrimary(spec, status), status ); } return node; }
void _is(char* test_name, const char* str1, const char* str2, char *file, int linenum) { int diff; if (str1 == NULL || str2 == NULL) { diff = 1; } else { diff = strcmp(str1, str2); } if (!test_name) test_name = "()"; _ok(test_name, (diff==0), file, linenum, ""); if (diff) { printf("# got: %s\n", str1 ? str1 : "(null)"); printf("# expected: %s\n", str2 ? str2 : "(null)"); } }
static NodeRef ParseExpr( char **spec, int *status ) { NodeRef node = NIL; LegalToken optok; node = ParseTerm( spec, status ); while ( ((curtok == TOK_PLUS) || (curtok==TOK_MINUS)) && _ok(status) ) { optok = curtok; NextToken( spec, status ); node = NewNode( optok, 0, node, ParseTerm( spec, status), status ); } return node; }
void subtest(const char *name, void (*cb)(void)) { struct test_t test = {0}, *parent_tests; parent_tests = cur_tests; cur_tests = &test; ++test_level; note("Subtest: %s", name); cb(); done_testing(); --test_level; cur_tests = parent_tests; if (test.failed) cur_tests->failed = 1; _ok(! test.failed, "%s", name); }
/* * Parse and execute commands appearing on an input stream, sending output * to the output stream if specified */ void ADIcmdExec( ADIobj istream, ADIobj ostream, ADIstatus status ) { ADIobj cmd; ADIobj res; _chk_stat; do { ADInextToken( istream, status ); cmd = adix_prs_cmd( istream, status ); if ( _valid_q(cmd) ) { res = ADIexprEval( cmd, ADI__nullid, ADI__true, status ); if ( _valid_q(ADI_G_curint->exec.name) ) { ADIparseError( istream, ADI_G_curint->exec.code, "Break on unhandled exception %S", status, ADI_G_curint->exec.name ); if ( _valid_q(ADI_G_curint->exec.errtext) ) { adic_setecs( ADI_G_curint->exec.code, "%O", status, ADI_G_curint->exec.errtext ); } ADIexecAcceptI( ADI_G_curint->exec.name, status ); *status = SAI__OK; } else if ( _valid_q(res) ) { if ( _valid_q(ostream) ) { adix_print( ostream, res, 0, 1, status ); ADIstrmFprintf( ostream, "\n", status ); ADIstrmFflush( ostream, status ); } adic_erase( &res, status ); } /* Destroy the command */ adic_erase( &cmd, status ); } } while ( _ok(status) && (ADIcurrentToken(istream,status) != TOK__NOTATOK) ); }
void rec1_open_file( int expand, const char *file, INT file_len, char mode, INT *slot, int *newslot ) { /*+ */ /* Name: */ /* rec1_open_file */ /* Purpose: */ /* Open an existing file. */ /* Invocation: */ /* rec1_open_file( expand, file, file_len, mode, slot, newslot ) */ /* Description: */ /* This function opens an existing container file for reading or writing */ /* and allocates a new File Control Vector slot (if necessary) to refer */ /* to the file. Any new FCV slot is initialised and its number is */ /* returned. The file's reference count is left unchanged if it is */ /* already in use, or is set to zero if it is being opened for the first */ /* time. */ /* Parameters: */ /* int expand */ /* If expand is non-zero, then the file name supplied will be */ /* regarded as an abbreviated form of the full name of the file and */ /* will be expanded (according to the underlying operating system's */ /* rules) before use. Otherwise, the file name supplied is regarded */ /* as already fully expanded and will be used literally. This */ /* mechanism is provided to allow previously-expanded file names to */ /* be given, while allowing for the fact that expanding a file name */ /* twice may cause the wrong file to be identified (if the underlying */ /* file system has changed and/or the expanded file name contains */ /* special characters, for instance). */ /* const char *file */ /* Pointer to a char array containing the host file-system name of */ /* the container file to be opened. It should not be null terminated. */ /* If expand is non-zero, then leading and trailing white space will */ /* be ignored. If expand is zero, then the file name must be */ /* fully-expanded and white space may be significant. */ /* INT file_len */ /* Number of characters in the file name (excluding any terminating */ /* null, if present). */ /* char mode */ /* A character specifying the required file access mode: 'R' for */ /* read-only access or 'W' for write (or update) access. */ /* INT *slot */ /* Pointer to an integer in which the File Control Vector slot number */ /* allocated to the file will be returned. */ /* int *newslot */ /* Returns 1 if the FCV slot is a new one, otherwise 0 if the slot */ /* was already in use (i.e. the file was already open). */ /* Returned Value: */ /* void */ /* Copyright: */ /* Copyright (C) 1992 Science & Engineering Research Council */ /* Copyright (C) 2005 Particle Physics and Astronomy Research Council */ /* Licence: */ /* This program is free software; you can redistribute it and/or */ /* modify it under the terms of the GNU General Public License as */ /* published by the Free Software Foundation; either version 2 of */ /* the License, or (at your option) any later version. */ /* This program is distributed in the hope that it will be */ /* useful, but WITHOUT ANY WARRANTY; without even the implied */ /* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */ /* PURPOSE. See the GNU General Public License for more details. */ /* You should have received a copy of the GNU General Public */ /* License along with this program; if not, write to the Free */ /* Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, */ /* MA 02110-1301, USA */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* TIMJ: Tim Jenness (JAC, Hawaii) */ /* {@enter_new_authors_here@} */ /* History: */ /* 28-MAR-1991 (RFWS): */ /* Added prologue. */ /* 3-APR-1991 (RFWS): */ /* Fixed bug in passing of file name for error message. */ /* 3-MAY-1991 (RFWS): */ /* Re-structured to return an FCV slot number and to initialise the */ /* slot if necessary. */ /* 7-MAY-1991 (RFWS): */ /* Added a portable implementation. */ /* 21-MAY-1991 (RFWS): */ /* Remove trailing blanks from file names (portable version). */ /* 22-MAY-1991 (RFWS): */ /* Added defaulting of ".sdf" file extension in portable version. */ /* 12-JUN-1991 (RFWS): */ /* Fixed bug in testing of access mode. */ /* 28-JUN-1991 (RFWS): */ /* Removed initialisation of the VMS-specific FCV lid field (not */ /* necessary). Added function prototypes for VMS system calls. */ /* 11-SEP-1992 (RFWS): */ /* Do not increment the file reference count. This is now the */ /* caller's responsibility. */ /* 14-OCT-1992 (RFWS): */ /* Changed to a void function and to use separate string pointer and */ /* length arguments. */ /* 24-NOV-1992 (RFWS): */ /* Fixed error in assigning access mode for error message. */ /* 25-NOV-1992 (RFWS): */ /* Changed to extend the File Control Vector when necessary. */ /* 26-NOV-1992 (RFWS): */ /* Enhanced file name handling by using rec1_get_path. */ /* 1-DEC-1992 (RFWS): */ /* Added the expand parameter. */ /* 28-DEC-2005 (TIMJ): */ /* Use DAT__FLEXT rather than hard-coded ".SDF" */ /* 02-FEB-2006 (TIMJ): */ /* Free malloced memory if the slot is reused. */ /* {@enter_further_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Variables: */ #if defined (vms ) /* VMS version local variables: */ char esabuf[ NAM$C_MAXRSS ]; /* Expanded file name string buffer */ char rsabuf[ NAM$C_MAXRSS ]; /* Resultant file name string buffer */ struct FAB fab; /* RMS file access block */ struct NAM nam; /* RMS NAM block */ unsigned int systat; /* System status code */ unsigned short int iochan; /* File I/O channel */ #else /* Portable version local variables: */ FILE *iochan=NULL; /* File I/O stream */ #endif INT i; /* Loop counter for FCV slots */ INT lfns; /* Length of File Name String */ INT start; /* Array offset of first non-blank char */ char *fns; /* Pointer to file name string */ int mustopen=0; /* File must be opened? */ struct FCV *fcv; /* Pointer to File Control Vector element */ struct FID *fid; /* Pointer to File ID */ /* External References: */ #if defined( vms ) /* VMS version system calls: */ unsigned int SYS$OPEN( struct FAB *fab ); unsigned int SYS$PARSE( struct FAB *fab ); unsigned int SYS$SEARCH( struct FAB *fab ); #endif /*. */ /* Check the inherited global status. */ if ( !_ok( hds_gl_status ) ) return; /* Initialise. */ fns = NULL; fid = NULL; /* If necessary, modify the file name length to omit any trailing white */ /* space. */ start = 0; if ( expand ) { for ( ; file_len > 0; file_len-- ) { if ( !isspace( file[ file_len - 1 ] ) ) break; } /* Also strip white space from the start of the file name (but leave at */ /* least one character, even if the string is completely blank). */ for ( start = 0; start < ( file_len - 1 ); start++ ) { if ( !isspace( file[ start ] ) ) break; } } /* VMS version: */ /* =========== */ #if defined( vms ) /* Initialise the file FAB and NAM blocks. */ fab = cc$rms_fab; fab.fab$l_dna = DAT__FLEXT; fab.fab$b_dns = DAT__SZFLX; fab.fab$l_fna = file + start; fab.fab$b_fns = file_len - start; fab.fab$l_nam = &nam; nam = cc$rms_nam; nam.nam$l_esa = esabuf; nam.nam$b_ess = NAM$C_MAXRSS; nam.nam$l_rsa = rsabuf; nam.nam$b_rss = NAM$C_MAXRSS; /* Parse the file name, reporting any errors. */ systat = SYS$PARSE( &fab ); if ( !( systat & STS$M_SUCCESS ) ) { hds_gl_status = ( systat == RMS$_PRV ) ? DAT__FILPR : DAT__FILNF; emsSetnc( "FILE", file + start, file_len - start ); emsSyser( "MESSAGE", systat ); emsRep( "REC1_OPEN_FILE_1", "Error in file name \'^FILE\' - ^MESSAGE.", &hds_gl_status ); } /* Search for the file, again reporting errors. */ if ( _ok( hds_gl_status ) ) { systat = SYS$SEARCH( &fab ); if ( !( systat & STS$M_SUCCESS ) ) { hds_gl_status = ( systat == RMS$_PRV ) ? DAT__FILPR : DAT__FILNF; emsSetnc( "FILE", esabuf, nam.nam$b_esl ); emsSyser( "MESSAGE", systat ); emsRep( "REC1_OPEN_FILE_2", "Error searching for file ^FILE - ^MESSAGE.", &hds_gl_status ); } /* If the file was found successfully, then allocate memory to hold the */ /* File Name String and the File ID and copy the relevant information from */ /* the NAM block into this memory (adding a terminating null to the file */ /* name). */ else { lfns = nam.nam$b_rsl; rec_alloc_mem( lfns + 1, (void **) &fns ); rec_alloc_mem( sizeof( struct FID ), (void **) &fid ); if ( _ok( hds_gl_status ) ) { (void) memcpy( (void *) fns, (const void *) nam.nam$l_rsa, (size_t) lfns ); fns[ lfns ] = '\0'; (void) memcpy( (void *) fid, (const void *) nam.nam$t_dvi, sizeof( struct FID ) ); } } } /* Portable version: */ /* ================ */ #else /* If required, obtain the full path name of the file. */ if ( expand ) { rec1_get_path( file + start, file_len - start, &fns, &lfns ); } /* Otherwise, allocate space and copy the file name for use directly. */ else { lfns = file_len - start; rec_alloc_mem( lfns + 1, (void **) &fns ); if ( _ok( hds_gl_status ) ) { (void) memcpy( (void *) fns, (const void *) ( file + start ), (size_t) lfns ); fns[ lfns ] = '\0'; } } /* Allocate memory to hold the File ID and store file identification */ /* information in it. */ rec_alloc_mem( sizeof( struct FID ), (void **) &fid ); rec1_get_fid( fns, fid ); #endif /* Loop to search the File Control Vector for any slot which is currently */ /* open and associated with the same file. */ if ( _ok( hds_gl_status ) ) { *slot = rec_gl_endslot; *newslot = 1; for ( i = 0; i < rec_gl_endslot; i++ ) { /* Remember the number of the last slot which is not being used. */ if ( !rec_ga_fcv[ i ].open ) { *slot = i; } /* If a slot is open and the identification matches, then note that a new */ /* slot is not needed and quit searching */ else if ( !memcmp( (const void *) rec_ga_fcv[ i ].fid, (const void *) fid, sizeof( struct FID ) ) ) { *slot = i; *newslot = 0; break; } } /* If no File ID match or unused FCV slot was found, then a new slot must */ /* be used. */ if ( *slot == rec_gl_endslot ) { /* If there is insufficient space for another slot in the File Control */ /* Vector, then extend the FCV by doubling its size. If successful, */ /* initialise the new region to zero and record the new size. */ if ( *slot >= rec_gl_mxslot ) { rec_reall_mem( rec_gl_mxslot * 2 * sizeof( struct FCV ), (void **) &rec_ga_fcv ); if ( _ok( hds_gl_status ) ) { (void) memset( (void *) ( rec_ga_fcv + rec_gl_mxslot ), 0, sizeof( struct FCV ) * (size_t) rec_gl_mxslot ); rec_gl_mxslot *= 2; } } /* If OK, increment the count of FCV slots used. */ if ( _ok( hds_gl_status ) ) { rec_gl_endslot++; } } } /* See if the file needs opening. This will be necessary if a new FCV slot */ /* is being used or if the file is currently open for read-only access and */ /* write access is now required. */ if ( _ok( hds_gl_status ) ) { mustopen = *newslot || ( ( mode != 'R' ) && ( rec_ga_fcv[ *slot ].write == REC__NOIOCHAN ) ); /* If the file is to be opened... */ if ( mustopen ) { /* VMS version: */ /* =========== */ #if defined( vms ) /* Initialise the FAB block. */ fab.fab$l_fop = FAB$M_UFO | FAB$M_NAM; fab.fab$b_shr = FAB$M_SHRPUT | FAB$M_SHRGET | FAB$M_UPI; fab.fab$b_fac = ( mode == 'R' ) ? FAB$M_GET : ( FAB$M_GET | FAB$M_PUT ); /* Open the file, reporting any errors. */ systat = SYS$OPEN( &fab ); if ( !( systat & STS$M_SUCCESS ) ) { hds_gl_status = ( systat == RMS$_PRV ) ? DAT__FILPR : DAT__FILNF; emsSetnc( "FILE", rsabuf, nam.nam$b_rsl ); emsSetnc( "ACCESS", ( mode == 'R' ) ? "reading" : "writing", EMS__SZTOK ); emsSyser( "MESSAGE", systat ); emsRep( "REC1_OPEN_FILE_3", "Unable to open file ^FILE for ^ACCESS - ^MESSAGE.", &hds_gl_status ); } /* If the file was opened successfully, extract its I/O channel from the */ /* FAB block. */ else { iochan = (int) fab.fab$l_stv; } /* Portable version: */ /* ================ */ #else /* Open the file, checking for errors. */ iochan = fopen( (const char *) fns, ( mode == 'R' ) ? "rb" : "r+b"); if ( iochan == NULL ) { /* Categorise the possible error conditions, setting the appropriate status */ /* value. */ switch ( errno ) { case EACCES: hds_gl_status = DAT__FILPR; /* Access denied */ break; case EISDIR: hds_gl_status = DAT__FILIN; /* File is a directory */ break; case EROFS: hds_gl_status = DAT__FILPR; /* Read-only file system */ break; default: /* All other errors ==> */ hds_gl_status = DAT__FILNF; /* File not found */ break; } /* Report the error. */ emsSyser( "MESSAGE", errno ); emsSetnc( "FILE", fns, EMS__SZTOK ); emsSetnc( "ACCESS", ( mode == 'R' ) ? "read" : "read/write", EMS__SZTOK ); emsRep( "REC1_OPEN_FILE_4", "Error opening file ^FILE for ^ACCESS access - \ ^MESSAGE", &hds_gl_status ); } #endif } } /* If the file has been opened successfully but an old slot has been used, */ /* then simply store the new I/O channel in the slot. */ if ( _ok( hds_gl_status ) ) { if ( mustopen ) { if ( !*newslot ) { rec_ga_fcv[ *slot ].write = iochan; } /* If a new slot is being used, fill in the File Control Vector fields, */ /* marking the slot as open. */ else { fcv = &rec_ga_fcv[ *slot ]; fcv->name = fns; fcv->fid = fid; fcv->read = ( mode == 'R' ) ? iochan : REC__NOIOCHAN; fcv->write = ( mode == 'R' ) ? REC__NOIOCHAN : iochan; fcv->count = 0; fcv->dele = 0; fcv->open = 1; fcv->locked = 0; fcv->hcb = NULL; fcv->hcbmodify = 0; } } } /* If an error occurred, then deallocate any memory allocated for the File */ /* Name String and File ID. */ /* Also free the memory if we are reusing a slot (since the name is already */ /* stored and the copy is not used. */ if ( !_ok( hds_gl_status ) || !*newslot ) { rec_deall_mem( lfns + 1, (void **) &fns ); rec_deall_mem( sizeof( struct FID ), (void **) &fid ); } /* Exit the routine. */ return; }
void ADIpkgRequire( char *name, int nlen, ADIstatus status ) { ADIobj afname; ADIobj curp = ADI_G_pkglist; char fname[ADI_FILENAME_BUF]; FILE *fp; ADIobj nid, nstr; char *pptr; ADIobj pstream; ADIlogical there = ADI__false; int ulen = 0, flen; _chk_init; _chk_stat; if ( ! ADI_G_getenv ) { /* Not got ADI_LOAD_PATH yet */ ADI_G_ldpath = getenv( "ADI_LOAD_PATH" ); if ( ADI_G_ldpath ) ADI_G_ldpath_len = strlen( ADI_G_ldpath ); ADI_G_getenv = ADI__true; } /* Import name string to an ADI string */ _GET_STRING(name,nlen); adic_newv0c_n( name, nlen, &nid, status ); /* Search existing list of loaded packages */ while ( _valid_q(curp) && ! there ) { _GET_CARCDR(nstr,curp,curp); there = (! strx_cmpi( nid, nstr ) ); } /* Only load the package if not done so already */ if ( ! there ) { /* Scan directories looking for file */ pptr = ADI_G_ldpath; do { int i; flen = 0; if ( pptr ) { for( ;pptr[ulen] == ' ' && (ulen<ADI_G_ldpath_len) ; ulen++ ) {;} for( ;pptr[ulen] != PATH_SEPARATOR && (ulen<ADI_G_ldpath_len) ; ulen++ ) fname[flen++] = pptr[ulen]; fname[flen++] = FILE_DELIMITER; } for( i=0; i<nlen; i++ ) fname[flen++] = name[i]; strcpy( fname + flen, ".adi" ); fp = fopen( fname, "r" ); if ( pptr && ! fp ) ulen++; } while ( pptr && (ulen<flen) && ! fp ); if ( fp ) { /* Create name string */ adic_newv0c( fname, &afname, status ); /* Set up parser stream */ pstream = ADIstrmNew( "r", status ); ADIstrmExtendFile( pstream, afname, fp, status ); ADIcmdExec( pstream, ADI_G_curint->StdOut, status ); /* Close stream and file */ adic_erase( &pstream, status ); fclose( fp ); /* If ok mark package as loaded */ if ( _ok(status) ) { lstx_inscel( nid, &ADI_G_pkglisti, status ); } else adic_setecs( *status, "Error loading package %*s", status, nlen, name ); } else { adic_erase( &nid, status ); adic_setecs( ADI__INVARG, "Package /%*s/ not found", status, nlen, name ); } } /* Release temporary string */ else { adic_erase( &nid, status ); } }
int rec1_unlock_slot( int slot ) { /*+ */ /* Name: */ /* rec1_unlock_slot */ /* Purpose: */ /* Unlock a slot in the File Control Vector. */ /* Invocation: */ /* rec1_unlock_slot( slot ) */ /* Description: */ /* This function unlocks a slot in the File Control Vector, thereby */ /* allowing other users to write to the associated file. Before the file */ /* is actually unlocked, any modified Header Control Block information */ /* is written back to it, and associated blocks are removed from the */ /* Working Page List, with modified blocks being written back to the */ /* file. This flushing of cached data occurs even if the slot is not */ /* initially locked. */ /* Parameters: */ /* int slot */ /* Container file slot number in the File Control Vector. */ /* Returned Value: */ /* int rec1_unlock_slot */ /* The global status value current on exit. */ /* Notes: */ /* - This routine attempts to execute even if the HDS global status is */ /* set on entry, although no further error report will be made if it */ /* subsequently fails under these circumstances. */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* {@enter_new_authors_here@} */ /* History: */ /* 26-MAR-1991 (RFWS): */ /* Made into a separate module and added prologue. */ /* 3-APR-1991 (RFWS): */ /* Converted to attempt to execute under error conditions. */ /* 4-APR-1991 (RFWS): */ /* Changed sys_write to rec1_write_file. */ /* 16-APR-1991 (RFWS): */ /* Changed to deallocate the memory used for holding HCB information. */ /* 17-APR-1991 (RFWS): */ /* Only release the lock if all associated data were flushed */ /* successfully. */ /* 22-APR-1991 (RFWS): */ /* Report an error if the unlocking operation fails. */ /* 23-MAY-1991 (RFWS): */ /* Installed a POSIX implementation. */ /* 5-JUN-1991 (RFWS): */ /* Changed to take no action if the slot is not initially locked. */ /* 19-JUN-1991 (RFWS): */ /* Further changed to allow flushing of cached information even if */ /* the file is not locked. */ /* 28-JUN-1991 (RFWS): */ /* Added function prototype for VMS system call. */ /* 24-SEP-1991 (RFWS): */ /* Fixed bug. Modified blocks were deliberately not being written to */ /* their files if the file was marked for deletion. This was unsafe */ /* because the block might subsequently need to be re-read before the */ /* file was actually deleted. All modified blocks are now written */ /* back. */ /* 24-AUG-1992 (RFWS): */ /* Removed illegal casts, replaced with (void **) cast. */ /* 8-NOV-1993 (RFWS): */ /* Added flushing of output I/O streams in POSIX version. */ /* {@enter_further_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Variables: */ #if defined( vms ) /* VMS version local variables: */ unsigned int systat; /* System error code */ #elif HAVE_FCNTL /* POSIX version local variables: */ int fd; /* File descriptor */ struct flock lockbuf; /* Lock structure for fcntl */ #endif int i; /* Loop counter for cached blocks */ int wplsize; /* Size of working page list */ struct BCP *bcp; /* Pointer to Block Control Packet */ struct BCP *flink; /* Pointer to next Block Control Packet */ struct BID bid; /* Block ID */ unsigned char buf[ REC__SZBLK ]; /* Buffer for packed HCB information */ /* External References: */ #if defined( vms ) /* VMS version system calls: */ unsigned int SYS$DEQ ( unsigned int lkid, int valblk, /* Not used */ int acmode, /* Not used */ int flags ); /* Not used */ #endif /*. */ /* Begin a new error reporting context. */ emsBegin( &hds_gl_status ); /* See if the file's Header Control Block information is cached. */ if ( rec_ga_fcv[ slot ].hcb != NULL ) { /* If so, and it has been modified, then pack the HCB information into a */ /* buffer and write it back to the first block in the file. */ if ( rec_ga_fcv[ slot ].hcbmodify ) { rec1_pack_hcb( rec_ga_fcv[ slot ].hcb, buf ); rec1_write_file( slot, 1, buf, 1 ); } /* Reset the HCB modified flag and deallocate the memory used to hold the */ /* HCB information. */ if ( _ok( hds_gl_status ) ) { rec_ga_fcv[ slot ].hcbmodify = 0; rec_deall_mem( sizeof( struct HCB ), (void **) &rec_ga_fcv[ slot ].hcb ); } } /* Scan through the Working Page List. */ wplsize = rec_gl_wplsize; bcp = rec_ga_wpl; for ( i = 0; i < wplsize; i++ ) { flink = bcp->flink; /* Write any modified blocks back to the container file. */ bid = bcp->bid; if ( bid.slot == slot ) { rec1_flush_block( bcp ); /* Deallocate the memory used to hold each block and return its Block */ /* Control Packet to the Free Page List. */ rec_deall_mem( REC__SZBLK, (void **) &bcp->bloc ); (bcp->bid).slot = 0; (bcp->bid).bloc = 0; bcp->count = 0; _remque( bcp, rec_ga_wpl ); _insque( bcp, rec_ga_fpl ); rec_gl_wplsize--; } bcp = flink; } /* POSIX version: */ /* ============= */ #if !defined( vms ) /* Not required on VMS */ /* If the slot is open for writing, then we must flush the I/O stream to */ /* hand off the file handle (POSIX terminology), since the file might next */ /* be accessed by another process. */ if ( _ok( hds_gl_status ) && ( rec_ga_fcv[ slot ].write != REC__NOIOCHAN ) ) { /* Flush the stream, checking for errors. */ if ( fflush( rec_ga_fcv[ slot ].write ) ) { hds_gl_status = DAT__FILWR; rec1_fmsg( "FILE", slot ); emsSyser( "MESSAGE", errno ); emsRep( "REC1_UNLOCK_SLOT_1", "Unable to flush written data to the file ^FILE - \ ^MESSAGE", &hds_gl_status ); } }
void rec1_get_path( const char *fname, INT fname_len, char **path, INT *path_len ) { /*+ */ /* Name: */ /* rec1_get_path */ /* Purpose: */ /* Obtain a full path name for a file (UNIX & POSIX only). */ /* Invocation: */ /* rec1_get_path( fname, fname_len, path, path_len ) */ /* Description: */ /* The routine translates a file name, which may be absolute or relative */ /* and which may contain shell meta-characters, into a full path name. A */ /* default file type extension of ".sdf" is added if appropriate. */ /* Leading and trailing white space is ignored. */ /* Parameters: */ /* const char *fname */ /* Pointer to a char array containing the original file name (not */ /* null terminated). The file need not necessarily exist, although */ /* the file system will be searched to identify it if shell */ /* pattern-matching characters are included. */ /* INT fname_len */ /* Number of characters in the original file name. */ /* char **path */ /* The value of *path will be set by this routine to point at a */ /* null-terminated character string containing the fully-expanded */ /* path name for the file. This path name occupies space dynamically */ /* allocated by rec_alloc_mem. It should be deallocated by the caller */ /* (using rec_deall_mem) when no longer required. The amount of space */ /* allocated is equal to (*path_len + 1) bytes. */ /* INT *path_len */ /* Pointer to an integer which will be set to the number of */ /* characters in the expanded path name, excluding the terminating */ /* null. */ /* Returned Value: */ /* void */ /* Notes: */ /* - If the file specification contains pattern matching characters and */ /* matches more than one file, then the first match will be used. */ /* - A value of NULL will be returned in *path and a value of zero in */ /* *path_len if this routine is called with the global status set, or if */ /* it should fail for any reason. */ /* - This routine is only implemented for UNIX & POSIX systems. */ /* Copyright: */ /* Copyright (C) 1992 Science & Engineering Research Council */ /* Copyright (C) 2005 Particle Physics and Astronomy Research Council */ /* Licence: */ /* This program is free software; you can redistribute it and/or */ /* modify it under the terms of the GNU General Public License as */ /* published by the Free Software Foundation; either version 2 of */ /* the License, or (at your option) any later version. */ /* This program is distributed in the hope that it will be */ /* useful, but WITHOUT ANY WARRANTY; without even the implied */ /* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */ /* PURPOSE. See the GNU General Public License for more details. */ /* You should have received a copy of the GNU General Public */ /* License along with this program; if not, write to the Free */ /* Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, */ /* MA 02110-1301, USA */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK, RAL) */ /* PWD: Peter W. Draper (STARLINK, Durham University) */ /* TIMJ: Tim Jenness (JAC, Hawaii) */ /* {@enter_new_authors_here@} */ /* History: */ /* 25-NOV-1992 (RFWS): */ /* Original version. */ /* 9-DEC-1992 (RFWS): */ /* Report an error if the file name is completely blank. */ /* 21-JUL-2004 (PWD): */ /* Add changes to support MinGW under Windows (no process control, */ /* plus Windows filename conventions), so that we can build */ /* shareable libraries for JNIHDS. */ /* 28-DEC-2005 (TIMJ): */ /* Use DAT__FLEXT rather than hard-coded ".sdf" */ /* {@enter_further_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Constants: */ #if defined( PATH_MAX ) const INT mxbuf0 = PATH_MAX; /* Initial size of file name buffer */ #else const INT mxbuf0 = _POSIX_PATH_MAX; #endif /* Local Variables: */ FILE *stream; /* Stream for reading file name */ INT i; /* Loop counter for file name characters */ INT idot=0; /* Character position of last dot */ INT islash=0; /* Character position of last slash */ INT lcwd; /* Length of working directory string */ INT mxbuf=0; /* Allocated size of buffer */ INT start; /* Array index of first non-blank char */ char *buffer; /* Pointer to buffer for reading file name */ char *cwd; /* Pointer to working directory string */ char c; /* File name character read from stream */ const char *basename=NULL; /* Pointer to base file name */ int absolute; /* Absolute path name? */ int extn; /* File type extension present? */ int lbase=0; /* Number of characters in basename string */ int special=0; /* Special characters in file name? */ int stat_val; /* Shell process status information */ pid_t pid; /* ID of shell process */ #if __MINGW32__ /* Use Windows separator */ #define SLASH '\\' #else #define SLASH '/' #endif /*. */ /* Set initial null values for the returned results. */ *path = NULL; *path_len = 0; /* Check the inherited global status. */ if ( !_ok( hds_gl_status ) ) return; /* Initialise. */ buffer = NULL; pid = (pid_t) -1; /* Modify the file name length to omit any trailing white space. */ for ( ; fname_len > 0; fname_len-- ) { if ( !isspace( fname[ fname_len - 1 ] ) ) break; } /* Also strip white space from the start of the file specification. */ for ( start = 0; start < fname_len; start++ ) { if ( !isspace( fname[ start ] ) ) break; } /* If the file name is completely blank, then report an error. */ if ( start == fname_len ) { hds_gl_status = DAT__FILNF; emsRep( "REC_GET_PATH_1", "Invalid blank file name given.", &hds_gl_status ); } /* Scan the file name, classifying the characters that appear in it. */ else { idot = islash = special = 0; for ( i = start; i < fname_len; i++ ) { switch ( fname[ i ] ) { /* Note where the last dot '.' occurs. */ case '.': idot = i + 1; break; /* Note where the last slash '/' occurs. */ case SLASH: islash = i + 1; break; /* Underscore '_' and hyphen '-' are portable file name characters, so take */ /* no action on these. */ case '_': case '-': break; /* If any other characters which are not in the POSIX.1 portable filename */ /* character set are encountered, then note that the file name contains */ /* special characters. */ default: if ( !isalnum( fname[ i ] ) ) { special = 1; } break; } } } /* Ignore the possible presence of special characters if the HDS__SHELL */ /* tuning parameter specifies that shell expansion of such characters is */ /* not to occur. */ #if __MINGW32__ /* MinGW doesn't offer a shell facility so make sure it is disabled */ hds_gl_shell = HDS__NOSHELL; special = 0; #else if ( hds_gl_shell == HDS__NOSHELL ) special = 0; #endif /* If there are no speciaal characters present, then the file name can be */ /* used as the basis of the full path name, without further translation. */ if ( !special ) { basename = fname + start; /* Note if a file type extension is present, as indicated by a dot '.' in */ /* the final field of the file name (i.e. after the last slash '/'). Find */ /* how much of the file name must be used after omitting exactly one final */ /* dot '.', if present (it is a general rule in HDS that this operation is */ /* performed on file names before use). */ extn = ( idot > islash ); lbase = fname_len - start - ( idot == fname_len ); } /* If special characters are present in the file name, then we must use a */ /* shell process to interpret them. We only do this if it is really */ /* necessary, since it is slower. Note that file extension information will */ /* be handled and start a shell process for finding files. */ else { extn = 1; rec1_find_file( fname + start, fname_len - start, &pid, &stream ); if ( _ok( hds_gl_status ) ) { /* Allocate initial space for a buffer to hold the expanded file name. */ rec_alloc_mem( mxbuf0, (void **) &buffer ); if ( _ok( hds_gl_status ) ) mxbuf = mxbuf0; /* Read the name of the first file found. Loop to read characters one at a */ /* time and append them to the file name until an error or end of file */ /* occurs, or a blank character is read. */ lbase = 0; while ( _ok( hds_gl_status ) ) { (void) fread( (void *) &c, sizeof( char ), (size_t) 1, stream ); /* If an error occurs, then report it and quit reading. */ if ( ferror( stream ) ) { hds_gl_status = DAT__FATAL; emsSyser( "MESSAGE", errno ); emsRep( "REC_GET_PATH_2", "Error reading file names from stream attached \ to shell process - ^MESSAGE", &hds_gl_status ); break; } /* If an end of file occurs, or a blank character is read, then we have */ /* reached the end of the file name, so quit reading. */ else if ( feof( stream ) || isspace( c ) ) { break; } /* The character just read must now be appended to the file name. Check */ /* that the file name buffer is large enough to hold it. If not, then */ /* extend the buffer by doubling its length and record its new size. */ if ( lbase >= mxbuf ) { rec_reall_mem( mxbuf * 2, (void **) &buffer ); if ( _ok( hds_gl_status ) ) { mxbuf *= 2; } } /* If OK, append the character to the file name. */ if ( _ok( hds_gl_status ) ) { buffer[ lbase++ ] = c; } } /* If no file name characters were read, then there was no file name match, */ /* so report an error. */ if ( lbase == 0 ) { hds_gl_status = DAT__FILNF; emsSetnc( "FILE", fname + start, fname_len - start ); emsRep( "REC_GET_PATH_3", "No files found matching the file specification \ \'^FILE\'.", &hds_gl_status ); } /* Close the stream and check for errors. Do this inside a new error */ /* reporting environment, since we may be cleaning up after a previous */ /* error. */ emsBegin( &hds_gl_status ); if ( fclose ( stream ) != 0 ) { hds_gl_status = DAT__FATAL; emsSyser( "MESSAGE", errno ); emsRep( "REC_GET_PATH_4", "Error closing stream used to read file names from \ a shell process - ^MESSAGE", &hds_gl_status ); }
ADIobj adix_prs_try( int narg, ADIobj args[], ADIstatus status ) { ADIobj pstream = args[0]; int choice; /* Keyword choice */ ADIlogical first = ADI__true; /* First time through complex loop? */ ADIlogical more = ADI__true; /* More ELSE clauses */ ADIobj robj = ADI__nullid; /* Returned object */ ADIobj action; /* Action procedure */ ADIobj *ipoint = &robj; /* List insertion point */ /* Skip the TRY keyword */ ADInextToken( pstream, status ); /* End of line with TRY on it */ ADImatchToken( pstream, TOK__END, status ); /* Get actions which might trigger exceptions */ action = adix_prs_cmdlist( pstream, "|catch|finally|endtry", &choice, status ); lstx_inscel( action, &ipoint, status ); /* While more clauses*/ do { /* Command list */ action = adix_prs_cmdlist( pstream, "|catch|finally|endtry", &choice, status ); } while ( more && _ok(status) ); /* There are 2 forms of 'if' statement. The simple form is simply * * if ( expr ) statement * * which is trapped here on the presence of the 'then' keyword. */ if ( ADIisTokenCstring( pstream, "then", status ) ) { /* While more if..else if..endif clauses */ while ( _ok(status) && more ) { /* Get the conditional expression unless the first time through */ if ( first ) first = ADI__false; else { ADImatchToken( pstream, TOK__LPAREN, status ); lstx_inscel( ADIparseExpInt( pstream, ADI__nullid, 1, status ), &ipoint, status ); ADImatchToken( pstream, TOK__RPAREN, status ); } /* Skip the 'then' token if present */ if ( ADIisTokenCstring( pstream, "then", status ) ) { ADInextToken( pstream, status ); ADImatchToken( pstream, TOK__END, status ); } else ADIparseError( pstream, ADI__SYNTAX, "THEN keyword expected", status ); /* Append truth action list */ lstx_inscel( adix_prs_cmdlist( pstream, "|else|endif", &choice, status ), &ipoint, status ); if ( _ok(status) ) { /* Match the ELSE or ENDIF */ ADInextToken( pstream, status ); /* The keyword was ELSE */ if ( choice == 1 ) { if ( ADIcurrentToken(pstream,status) == TOK__SYM ) { if ( ADIisTokenCstring( pstream, "if", status ) ) ADInextToken( pstream, status ); else ADIparseError( pstream, ADI__SYNTAX, "Illegal token - can only be IF () THEN or end of line at this point", status ); } else { /* Terminal ELSE clause */ ADImatchToken( pstream, TOK__END, status ); lstx_inscel( adix_prs_cmdlist( pstream, "|endif", &choice, status ), &ipoint, status ); /* Match the "endif" */ ADInextToken( pstream, status ); more = ADI__false; } } /* The keyword was ENDIF. Flag end of loop */ else more = ADI__false; } } } else { /* Parse a single statement, and put into the action list */ action = lstx_cell( adix_prs_cmd( pstream, status ), ADI__nullid, status ); /* Add action list to output args */ lstx_inscel( action, &ipoint, status ); } /* Return the expression tree */ return ADIetnNew( adix_clone( K_Try, status ), robj, status ); }
int dat1_alloc_lcp( struct LOC **loc, struct LCP **lcp ) { /*+ */ /* Name: */ /* dat1_alloc_lcp */ /* Purpose: */ /* Allocate a Locator Control Packet and initialise a locator. */ /* Invocation: */ /* dat1_alloc_lcp( loc, lcp ) */ /* Description: */ /* This function allocates a new Locator Control Packet (LCP) to control */ /* user access to an HDS object and initialises a locator, thereby */ /* associating it with the allocated LCP. */ /* Parameters: */ /* struct LOC **loc */ /* Pointer to a pointer to a struct LOC that is to be filled with the */ /* locator information. Will be malloced by this routine and freed */ /* with a datAnnul. *loc Must be NULL on entry. */ /* struct LCP **lcp */ /* Pointer to a pointer which will be set to identify the */ /* newly-allocated LCP. A null pointer will be returned in *lcp if */ /* this routine is invoked with the global status set, or if it */ /* should fail for any reason. */ /* Returned Value: */ /* int dat1_alloc_lcp */ /* The global status value current on exit. */ /* Notes: */ /* The returned LCP will have its data fields and "primary locator" flag */ /* initialised to zero. Its sequence number will be set to match that of */ /* the locator. */ /* Copyright: */ /* Copyright (C) 1992 Science & Engineering Research Council */ /* Copyright (C) 2005-2006 Particle Physics and Astronomy Research Council */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* TIMJ: T. Jenness (JAC, Hawaii) */ /* {@enter_new_authors_here@} */ /* History: */ /* 14-OCT-1992 (RFWS): */ /* Substantially new routine based on old original. */ /* 15-NOV-2005 (TIMJ): */ /* Change API to use the struct LOC explcitly */ /* 23-FEB-2006 (TIMJ): */ /* use rec_alloc_mem */ /* {@enter_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Variables: */ /*. */ /* Set an initial null value for the returned LCP pointer. */ *lcp = NULL; /* Check the inherited global status. */ if ( !_ok( hds_gl_status ) ) return hds_gl_status; /* Check that the locator is NULL */ if (*loc != NULL ) { hds_gl_status = DAT__LOCIN; emsRep( "DAT1_ALLOC_LCP", "Supplied locator is not a NULL pointer (Possible programming error)", &hds_gl_status); return hds_gl_status; } /* Ensure that HDS has been initialised. */ if ( !hds_gl_active ) { dat1_init( ); } /* If the Free Locator Queue is empty, then refill it. */ if ( dat_ga_flq == NULL ) { dau_refill_flq( ); } /* Allocate a new LCP from the free queue. */ if( _ok( hds_gl_status ) ) { *lcp = dat_ga_flq; _remque( *lcp, dat_ga_flq ); /* Clear the LCP data fields and the primary LCP flag. */ (void) memset( (void *) &(*lcp)->data, 0, sizeof( struct LCP_DATA ) ); (*lcp)->primary = 0; /* Insert the LCP at the head of the Working Locator Queue and increment */ /* the Queue size. */ _insque( *lcp, dat_ga_wlq ); dat_gl_wlqsize++; /* Initialise the locator information, including the locator sequence */ /* number which is duplicated in the LCP. */ if (rec_alloc_mem( sizeof(struct LOC), (void**)loc ) == DAT__OK) { (*loc)->check = DAT__LOCCHECK; (*loc)->lcp = *lcp; (*loc)->seqno = (*lcp)->seqno = ++hds_gl_locseq; } } /* Exit the routine. */ return hds_gl_status; }
int rec_get_handle( const struct RID *rid, const struct HAN *kin, struct HAN *han ) { /*+ */ /* Name: */ /* rec_get_handle */ /* Purpose: */ /* Obtain a handle for a record in a container file. */ /* Invocation: */ /* rec_get_handle( rid, kin, han ) */ /* Description: */ /* This function returns a handle for a record in a container file whose */ /* record ID is known. A handle for another record in the same file must */ /* also be supplied. */ /* Parameters: */ /* const struct RID *rid */ /* Pointer to a RID structure containing the record ID for the */ /* record. */ /* const struct HAN *kin */ /* Pointer to a HAN structure containing a handle for any other */ /* record in the same container file. */ /* struct HAN *han */ /* Pointer to a HAN structure in which the new handle will be */ /* returned. */ /* Returned Value: */ /* int rec_get_handle */ /* The global status value current on exit. */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* BKM: B.K, McIlwrath (STARLINK) */ /* {@enter_new_authors_here@} */ /* History: */ /* 14-APR-1991 (RFWS): */ /* Added prologue and error handling and tidied. */ /* 19-APR-2004 (BKM): */ /* Revise for 64-bit HDS files. */ /* {@enter_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Variables: */ struct RCL rcl; /*. */ /* Check the inherited global status. */ if ( !_ok( hds_gl_status ) ) return hds_gl_status; /* Copy the File Control Vector slot number and read flag from the handle */ /* supplied and insert the record ID into the new handle. */ han->slot = kin->slot; han->read = kin->read; han->rid = *rid; rec_get_rcl(han, &rcl); /* Return the current global status value. */ return hds_gl_status; }
void rec_wild_file( const char *fspec, INT fspec_len, struct WLD **context, int *alldone, char **fname, INT *fname_len ) { /*+ */ /* Name: */ /* rec_wild_file */ /* Purpose: */ /* Return successive file names matching a wild-card file specification. */ /* Invocation: */ /* rec_wild_file( fspec, fspec_len, context, alldone, fname, fname_len ) */ /* Description: */ /* On the first invocation (when *context is NULL), the routine searches */ /* the host file system for files matching the supplied wild-card file */ /* specification and allocates a struct WLD structure to contain the */ /* resulting list of file names. A pointer to the allocated structure, a */ /* pointer to the first file name and the associated file name length */ /* are returned. On subsequent invocations (when a pointer to a */ /* previously-allocated struct WLD structure is supplied in *context), */ /* the routine simply returns a pointer to the next file name (together */ /* with its length) as stored within the structure. The *alldone flag is */ /* set if no more file names remain. */ /* Parameters: */ /* const char *fspec */ /* Pointer to a char array containing the wild-card file */ /* specification (not null terminated). The syntax depends on the */ /* host operating system. Leading and trailing white space is */ /* ignored. */ /* INT fspec_len */ /* Length of the array holding the wild-card file specification. */ /* struct WLD **context */ /* If *context is NULL on entry, then a new search is initiated and a */ /* pointer to the newly-allocated search context structure is */ /* returned in *context. Otherwise, *context is used to supply a */ /* pointer to a previously-allocated search contect structure from */ /* which the next file name will be returned. The context structure */ /* supplied will be validated to ensure that it was created by a */ /* previous invocation of this routine. */ /* int *alldone */ /* If no more file names remain to be returned, then *alldone will be */ /* set to 1, otherwise it will be set to 0. */ /* char **fname */ /* If the routine returns successfully with *alldone is set to zero, */ /* then *fname will return a pointer to a null-terminated character */ /* string containing the name of the next file matching the wild-card */ /* file specification. This will be a pointer into memory managed by */ /* the search context structure and should not be modified or */ /* deallocated by the caller of this routine. */ /* INT *fname_len */ /* Pointer to an integer to receive the length of the file name */ /* pointed at by *fname (excluding the terminating null). */ /* Returned Value: */ /* void */ /* Notes: */ /* - The files identified by this routine are checked to ensure that */ /* they exist at the time of the initial invocation (when *context is */ /* supplied as NULL on entry). It is not guaranteed that they will also */ /* be accessible (i.e. readable or writable), nor that they will still */ /* exist at the time their names are returned from a previously-created */ /* context structure by subsequent invocations of the routine. */ /* - All memory allocated by this routine is managed via information */ /* stored in the search context structure pointed at by *context. It */ /* should only be deallocated via a call to the routine rec_end_wild, */ /* which should always be used to terminate a wild-card search when it */ /* is complete. */ /* Copyright: */ /* Copyright (C) 1992 Science & Engineering Research Council */ /* Copyright (C) 2005 Particle Physics and Astronomy Research Council */ /* Licence: */ /* This program is free software; you can redistribute it and/or */ /* modify it under the terms of the GNU General Public License as */ /* published by the Free Software Foundation; either version 2 of */ /* the License, or (at your option) any later version. */ /* This program is distributed in the hope that it will be */ /* useful, but WITHOUT ANY WARRANTY; without even the implied */ /* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */ /* PURPOSE. See the GNU General Public License for more details. */ /* You should have received a copy of the GNU General Public */ /* License along with this program; if not, write to the Free */ /* Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, */ /* MA 02110-1301, USA */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK, RAL) */ /* TIMJ: Tim Jenness (JAC, Hawaii) */ /* {@enter_new_authors_here@} */ /* History: */ /* 17-NOV-1992 (RFWS): */ /* Original version. */ /* 9-DEC-1992 (RFWS): */ /* Report an error if the file specification is completely blank. */ /* 28-DEC-2005 (TIMJ): */ /* Use DAT__FLEXT rather than hard-coded ".SDF" */ /* 4-MAR-2006 (TIMJ): */ /* Use emsSetp to create pointer value error token */ /* {@enter_further_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Macros: */ #if defined( vms ) /* VMS version local macros: */ #define SZFIL 512 /* Maximum size of a file name */ #endif /* Local Constants: */ const INT mxlist0 = 64; /* Initial size of file name list */ #if defined( vms ) /* VMS version local constants: */ /* None required */ #else /* Portable version local constants: */ #if defined( PATH_MAX ) const INT mxbuf0 = PATH_MAX + 1; /* Initial size of file name buffer */ #else const INT mxbuf0 = _POSIX_PATH_MAX + 1; #endif #endif /* Local Variables: */ #if defined( vms ) /* VMS version local variables: */ INT lname; /* Number of characters in file name */ INT nfile; /* Number of file names found */ char *mem; /* Pointer to allocated memory */ char buffer[ SZFIL ]; /* Buffer for returned file name */ struct dsc$descriptor def; /* Descriptor for default file spec */ struct dsc$descriptor filespec; /* Descriptor for file specification */ struct dsc$descriptor result; /* Descriptor for resultant file name */ unsigned int ictx; /* LIB$FIND_FILE context value */ unsigned int systat; /* System status code */ #else /* Portable version local variables: */ FILE *stream; /* Stream for reading file names */ INT lcwd; /* Length of working directory string */ INT lname; /* Length of full file name */ INT mxbuf=0; /* Allocated size of buffer */ INT nfile; /* Number of file names found */ char *buffer; /* Pointer to buffer for reading file name */ char *cwd; /* Pointer to working directory string */ char *mem; /* Pointer to allocated memory */ char c; /* Character read from pipe */ int absolute; /* Absolute path name obtained? */ int lbase; /* Number of characters in base file name */ int stat_val; /* Shell process status information */ pid_t pid; /* ID of shell process */ #endif INT current; /* Current file name index */ INT start; /* Array offset of first non-blank char */ int again; /* Loop again? */ int valid; /* Wild-card context ID valid? */ struct WLD *next; /* Next wild-card context in queue */ struct WLD *qpntr; /* Pointer into wild-card context queue */ /* External References: */ #if defined( vms ) /* VMS version system routines: */ unsigned int LIB$FIND_FILE /* Perform wild-card file search */ ( struct dsc$descriptor *filespec, struct dsc$descriptor *result, unsigned int *context, struct dsc$descriptor *defspec, struct dsc$descriptor *relspec, unsigned int *rmsstat, unsigned int *flags ); unsigned int LIB$FIND_FILE_END /* End wild-card file search */ ( unsigned int *context ); #endif /*. */ /* Check the inherited global status. */ if ( !_ok( hds_gl_status ) ) return; /* Validate an existing context. */ /* ============================ */ /* If the wild-card search context supplied was not null, then loop to */ /* validate it by comparing it with each context currently on the wild-card */ /* context queue. */ if ( *context != NULL ) { valid = 0; again = 1; for( qpntr = rec_gl_wldque; again; qpntr = next ) { /* Quit testing if a match is found. */ if ( qpntr == *context ) { valid = 1; break; } /* Otherwise return to test against the next queue element, so long as we */ /* have not yet returned to the head of the queue. */ next = qpntr->flink; again = ( next != rec_gl_wldque ); } /* If no match was found, then report an error. */ if ( !valid ) { hds_gl_status = DAT__WLDIN; emsSetp( "IWLD", *context ); emsRep( "REC_WILD_FILE_1", "Wild-card search context identifier is invalid; value \ is ^IWLD (possible programming error).", &hds_gl_status ); }
int hdsState( int *state, int *status) { /* *+ * Name: * HDS_STATE * Purpose: * Enquire the current state of HDS. * Language: * ANSI C * Invocation: * CALL HDS_STATE( STATE, STATUS ) * Description: * This routine returns a logical value indicating whether HDS is * currently active or inactive. * Arguments: * STATE = LOGICAL (Returned) * The current state of HDS: .TRUE. for active, .FALSE. for * inactive. * STATUS = INTEGER (Given and Returned) * The global status. * Authors: * RFWS: R.F. Warren-Smith (STARLINK, RAL) * BKM: B.K. McIlwrath (STARLINK, RAL) * {enter_new_authors_here} * History: * 4-APR-1991 (RFWS): * Added prologue and made portable. * 6-AUG-1991 (RFWS): * Changed to handle TRUE/FALSE correctly on all machines. * 13-DEC-2001 (BKM) * Convert to a C function with FORTRAN wrapper. * {enter_further_changes_here} * Bugs: * {note_any_bugs_here} *- */ /*. */ /* Check the inherited global status. */ if ( !_ok( *status ) ) return *status; /* Check if HDS is active. */ *state = hds_gl_active ? TRUE : FALSE; /* Exit the routine. */ return *status; }
int main(int argc, char** argv) { int nerrs = 0; int testi; float testf; double testd; dat1_init(); if (!_ok(hds_gl_status)) { fprintf(stderr, "Can't initialise HDS\n"); exit (1); } #define stringize(x) # x #define testval_prm(ifd, prefix, NUM, num, type) \ if (prefix ## __ ## NUM ## type != dat_gl_ndr[DAT__ ## type].num.type) { \ test ## ifd = prefix ## __ ## NUM ## type; \ printf(stringize(prefix ## __ ## NUM ## type) ": %s", \ tohex(stringize(ifd), (byte*)&test ## ifd)); \ printf(" != %s\n", \ tohex(stringize(ifd), \ (byte*)&dat_gl_ndr[DAT__ ## type].num.type)); \ nerrs++; \ } #define testval(ifd, prefix, NUM, num, type) \ if (prefix ## __ ## NUM ## type != dat_gl_ndr[DAT__ ## type].num) { \ test ## ifd = prefix ## __ ## NUM ## type; \ printf(stringize(prefix ## __ ## NUM ## type) ": %s", \ tohex(stringize(ifd), (byte*)&test ## ifd)); \ printf(" != %s\n", \ tohex(stringize(ifd), \ (byte*)&dat_gl_ndr[DAT__ ## type].num)); \ nerrs++; \ } /* * Compare values in prm_par.h against the values in the struct * NDR, as initialised by dat1_init_ndr.c. Excerpts: * * union PRM * { * _BYTE B; * _DOUBLE D; * _INTEGER I; * _LOGICAL L; * _REAL R; * _UBYTE UB; * _UWORD UW; * _WORD W; * _CHAR C; * }; * struct NDR * { * union PRM bad; -- "Bad" data value * union PRM max; -- Maximum value * union PRM min; -- Minimum (most negative) value * const char *name; -- Pointer to data type name * unsigned short int length; -- Size of data element * unsigned char format; -- Data format code * unsigned char order; -- Storage order code * unsigned char digits; -- No. decimal digits of precision * unsigned char txtsize; -- Characters required for formatting * }; * * Some prm_par.h settings have no analogue in NDR: * val__eps -- Machine precision * val__max -- Maximum (most positive) non-bad value * val__min -- Minimum (most negative) non-bad value * val__sml -- Smallest positive value */ /* Bad values, used for flagging undefined data. */ testval_prm(i, VAL, BAD, bad, UB); testval_prm(i, VAL, BAD, bad, B); testval_prm(i, VAL, BAD, bad, UW); testval_prm(i, VAL, BAD, bad, W); testval_prm(i, VAL, BAD, bad, I); testval_prm(f, VAL, BAD, bad, R); testval_prm(d, VAL, BAD, bad, D); /* Maximum (most positive) number */ testval_prm(i, NUM, MAX, max, UB); testval_prm(i, NUM, MAX, max, B); testval_prm(i, NUM, MAX, max, UW); testval_prm(i, NUM, MAX, max, W); testval_prm(i, NUM, MAX, max, I); testval_prm(f, NUM, MAX, max, R); testval_prm(d, NUM, MAX, max, D); /* Minimum (most negative) number */ testval_prm(i, NUM, MIN, min, UB); testval_prm(i, NUM, MIN, min, B); testval_prm(i, NUM, MIN, min, UW); testval_prm(i, NUM, MIN, min, W); testval_prm(i, NUM, MIN, min, I); testval_prm(f, NUM, MIN, min, R); testval_prm(d, NUM, MIN, min, D); /* Number of basic machine units (bytes) used by a value. */ testval(i, VAL, NB, length, UB); testval(i, VAL, NB, length, B); testval(i, VAL, NB, length, UW); testval(i, VAL, NB, length, W); testval(i, VAL, NB, length, I); testval(i, VAL, NB, length, R); testval(i, VAL, NB, length, D); /* Number of characters required to format value as decimal string. */ testval(i, VAL, SZ, txtsize, UB); testval(i, VAL, SZ, txtsize, B); testval(i, VAL, SZ, txtsize, UW); testval(i, VAL, SZ, txtsize, W); testval(i, VAL, SZ, txtsize, I); testval(i, VAL, SZ, txtsize, R); testval(i, VAL, SZ, txtsize, D); exit(nerrs); }
void dat1_cvt_order( UINT_BIG nval, const struct PDD *imp, struct PDD *exp, int *status ) { /*+ */ /* Name: */ /* dat1_cvt_order */ /* Purpose: */ /* Convert the (byte) storage order of primitive data. */ /* Invocation: */ /* dat1_cvt_order( nval, imp, exp, status ) */ /* Description: */ /* This function reverses the order of characters (bytes) in each */ /* element of an array of primitive input data as part of converting */ /* between number representations on different machines. */ /* Parameters: */ /* UINT_BIG nval */ /* Number of data elements to be processed. */ /* const struct PDD *imp */ /* Pointer to a PDD descriptor for the array of input data. */ /* struct PDD *exp */ /* Pointer to a PDD descriptor for the array to receive the output */ /* data. */ /* int *status */ /* The inherited global status. */ /* Returned Value: */ /* void */ /* Notes: */ /* - This function will execute if *status is OK on input or if it is */ /* set to DAT__CONER (indicating a previous conversion error). */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* {@enter_new_authors_here@} */ /* History: */ /* 1-JUL-1991 (RFWS): */ /* Original version. */ /* 22-JUL-1991 (RFWS): */ /* Changed to use struct PDD descriptors as arguments. */ /* 26-JUL-1991 (RFWS); */ /* Changed to allow execution if status is set to DAT__CONER on */ /* entry. */ /* 20-NOV-2015 (DSB): */ /* Change nval from int to UNIT_BIG. */ /* {@enter_further_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Variables: */ UINT_BIG i; /* Loop counter for groups of chars */ int j; /* Loop counter for chars within groups */ int nswap; /* Number of characters to swap */ unsigned char *in; /* Pointer to input array */ unsigned char *out; /* Pointer to output array */ /*. */ /* Check the inherited global status. Allow the routine to execute if */ /* status is set to DAT__CONER indicating a previous conversion error. */ if ( !( _ok( *status ) || ( *status == DAT__CONER ) ) ) return; /* Obtain pointers to the input and output data arrays and determine the */ /* number of characters to be swapped. */ in = imp->body; out = exp->body; nswap = imp->length; /* Test for common special values of nswap. */ switch ( nswap ) { /* If nswap is 1, simply copy the characters. */ case 1: memcpy( (void *) out, (void *) in, nval * nswap ); break; /* If nswap is two, loop to swap characters in pairs. */ case 2: for ( i = 1; i < nval * nswap; i += 2 ) { out[ i - 1 ] = in[ i ]; out[ i ] = in[ i - 1 ]; } break; /* If nswap is four, loop to swap characters in groups of 4. */ case 4: for ( i = 3; i < nval * nswap; i += 4 ) { out[ i - 3 ] = in[ i ]; out[ i - 2 ] = in[ i - 1 ]; out[ i - 1 ] = in[ i - 2 ]; out[ i ] = in[ i - 3 ]; } break; /* If nswap is eight, loop to swap characters in groups of 8. */ case 8: for ( i = 7; i < nval * nswap; i += 8 ) { out[ i - 7 ] = in[ i ]; out[ i - 6 ] = in[ i - 1 ]; out[ i - 5 ] = in[ i - 2 ]; out[ i - 4 ] = in[ i - 3 ]; out[ i - 3 ] = in[ i - 4 ]; out[ i - 2 ] = in[ i - 5 ]; out[ i - 1 ] = in[ i - 6 ]; out[ i ] = in[ i - 7 ]; } break; /* For other values of nswap, cater for the general case. This involves an */ /* extra loop. */ default: for ( i = nswap - 1; i < nval * nswap; i += nswap ) { for ( j = 0; j < nswap; j++ ) { out[ i - j ] = in[ i + j - ( nswap - 1 ) ]; } } break; } /* Exit the routine. */ return; }
int rec_get_rcl( const struct HAN *han, struct RCL *rcl ) { /*+ */ /* Name: */ /* rec_get_rcl */ /* Purpose: */ /* Read a Record Control Label from a container file record. */ /* Invocation: */ /* rec_get_rcl( han, rcl ) */ /* Description: */ /* This function reads and unpacks the contents of the Record Control */ /* Label held in the Control Domain of a container file record for which */ /* a handle is supplied. The information is returned in an RCL */ /* structure. */ /* Parameters: */ /* const struct HAN *han */ /* Pointer to a HAN structure containing a handle for the required */ /* record. */ /* struct RCL *rcl */ /* Pointer to an RCL structure in which the unpacked Record Control */ /* Label information will be returned. */ /* Returned Value: */ /* int rec_get_rcl */ /* The global status value current on exit. */ /* Authors: */ /* RFWS: R.F. Warren-Smith (STARLINK) */ /* {@enter_new_authors_here@} */ /* History: */ /* 2-APR-1991 (RFWS): */ /* Added prologue and changed to unpack the information. */ /* 16-APR-1991 (RFWS): */ /* Eliminated unnecessary local variables and improved error */ /* handling. */ /* {@enter_further_changes_here@} */ /* Bugs: */ /* {@note_any_bugs_here@} */ /*- */ /* Local Variables: */ unsigned char *cdom; /* Pointer to LRB Control Domain */ unsigned char *lrb; /* Pointer to Logical Record Block */ /*. */ /* Check the inherited global status. */ if ( !_ok( hds_gl_status ) ) return hds_gl_status; /* Find the Logical Record Block which contains the required record. */ rec_locate_block( han->slot, han->rid.bloc, 'R', &lrb ); /* Locate the record's Control Domain and unpack the Record Control Label. */ cdom = lrb + REC__SZCBM + ( han->rid.chip * REC__SZCHIP ); rec1_unpack_rcl( cdom, rcl ); /* Release the Logical Record Block. */ if ( lrb != NULL ) rec_release_block( han->slot, han->rid.bloc ); /* Return the current global status value. */ return hds_gl_status; }