diff options
Diffstat (limited to 'ast/fchannel.c')
| -rw-r--r-- | ast/fchannel.c | 473 |
1 files changed, 473 insertions, 0 deletions
diff --git a/ast/fchannel.c b/ast/fchannel.c new file mode 100644 index 0000000..9f70315 --- /dev/null +++ b/ast/fchannel.c @@ -0,0 +1,473 @@ +/* +*+ +* Name: +* fchannel.c + +* Purpose: +* Define a FORTRAN 77 interface to the AST Channel class. + +* Type of Module: +* C source file. + +* Description: +* This file defines FORTRAN 77-callable C functions which provide +* a public FORTRAN 77 interface to the Channel class. + +* Routines Defined: +* AST_CHANNEL +* AST_ISACHANNEL +* AST_READ +* AST_WRITE + +* Copyright: +* Copyright (C) 1997-2006 Council for the Central Laboratory of the +* Research Councils + +* Licence: +* This program is free software: you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation, either +* version 3 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 Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General +* License along with this program. If not, see +* <http://www.gnu.org/licenses/>. + +* Authors: +* RFWS: R.F. Warren-Smith (Starlink) + +* History: +* 6-SEP-1996 (RFWS): +* Original version. +* 12-DEC-1996 (RFWS): +* Added SOURCE and SINK arguments to AST_CHANNEL. +* 13-NOV-2003 (DSB): +* Made SourceWrap and SinkWrap into protected functions rather +* than private functions, so that they can be used in fxmlchan.c +*/ + +/* Define the astFORTRAN77 macro which prevents error messages from + AST C functions from reporting the file and line number where the + error occurred (since these would refer to this file, they would + not be useful). */ +#define astFORTRAN77 + +/* Header files. */ +/* ============= */ +#include "f77.h" /* FORTRAN <-> C interface macros (SUN/209) */ +#include "c2f77.h" /* F77 <-> C support functions/macros */ +#include "error.h" /* Error reporting facilities */ +#include "memory.h" /* Memory handling facilities */ +#include "channel.h" /* C interface to the Channel class */ + +#include <stddef.h> + +/* Module Variables. */ +/* ================= */ +static char *line_in = NULL; /* Pointer to incoming line of text */ +static const char *line_out = NULL; /* Pointer to outgoing line of text */ + +/* Prototypes for external functions. */ +/* ================================== */ +/* This is the null function defined by the FORTRAN interface in fobject.c. */ +F77_SUBROUTINE(ast_null)( void ); + +/* Source and sink function interfaces. */ +/* ==================================== */ +/* These functions are concerned with allowing FORTRAN implementations + of Channel source and sink functions to be passed to the Channel + class and invoked when necessary by C code in the main class + implementation. All FORTRAN-specific aspects of this interface are + encapsulated here. */ +F77_SUBROUTINE(ast_getline)( CHARACTER(LINE), + INTEGER(L), + INTEGER(STATUS) + TRAIL(LINE) ) { +/* +f++ +* Name: +* AST_GETLINE + +* Purpose: +* Obtain text to be written by a Channel sink routine. + +* Type: +* Public function. + +* Synopsis: +* CALL AST_GETLINE( LINE, L, STATUS ) + +* Description: +* This routine should only be used when implementing a routine +* which will be passed as the SINK argument to AST_CHANNEL. It +* should be used to obtain (from the AST library) each line of +* text which is to be written to the external data sink. One such +* line should be obtained in this way for each invocation of the +* sink routine. + +* Parameters: +* LINE = CHARACTER * ( * ) (Returned) +* The line of text to be written. Depending on the length of +* character variable supplied, the returned text may be +* truncated if necessary. Note, however, that it will not be +* padded with blanks in order to fill this variable. +* L = INTEGER (Returned) +* The number of characters returned, which may be zero. Note +* that characters beyond the L'th character in the LINE +* variable are not modified and may therefore contain junk. +* STATUS = INTEGER (Given and Returned) +* The global status. + +* Notes: +* - This routine is only available in the Fortran interface to the +* AST library. +f-- +*/ + +/* Argument Pointers: */ + GENPTR_CHARACTER(LINE) + GENPTR_INTEGER(L) + +/* Local Variables: */ + int i; /* Loop counter for characters */ + +/* Set the error context and watch the STATUS value. */ + astAt( "AST_GETLINE", NULL, 0 ); + astWatchSTATUS( + +/* Initialise the returned string length. */ + *L = 0; + +/* Check the global error status. */ + if ( !astOK ) return; + +/* If there is no outgoing line ready (e.g. if this routine has been + called at an inappropriate point), we simply return + nothing. Otherwise, loop to copy the text into the character + argument supplied, ensuring that its length is not exceeded. */ + if ( line_out ) { + for ( i = 0; line_out[ i ] && ( i < LINE_length ); i++ ) { + LINE[ i ] = line_out[ i ]; + } + +/* Return the number of characters copied. */ + *L = i; + } + ) +} + +F77_SUBROUTINE(ast_putline)( CHARACTER(LINE), + INTEGER(L), + INTEGER(STATUS) + TRAIL(LINE) ) { +/* +f++ +* Name: +* AST_PUTLINE + +* Purpose: +* Store a text line read by a Channel source routine. + +* Type: +* Public function. + +* Synopsis: +* CALL AST_PUTLINE( LINE, L, STATUS ) + +* Description: +* This routine should only be used when implementing a routine +* which will be passed as the SOURCE argument to AST_CHANNEL. It +* should be used to pass back (to the AST library) each line of +* text read from the external data source. One such line should be +* passed back in this way for each invocation of the source +* routine. + +* Parameters: +* LINE = CHARACTER * ( * ) (Given) +* A character string containing the line of input text which +* has been read. +* L = INTEGER (Given) +* The number of characters in the input line, which may be +* zero. If there is no more input available (e.g. an end of +* file has been reached), this value should be set negative and +* this will terminate the read operation on the Channel. +* STATUS = INTEGER (Given and Returned) +* The global status. + +* Notes: +* - This routine is only available in the Fortran interface to the +* AST library. +f-- +*/ + +/* Argument Pointers: */ + GENPTR_CHARACTER(LINE) + GENPTR_INTEGER(L) + +/* Local Variables: */ + int l; /* Number of characters in line */ + +/* Set the error context and watch the STATUS value. */ + astAt( "AST_PUTLINE", NULL, 0 ); + astWatchSTATUS( + +/* Initialise the incoming line pointer. */ + line_in = NULL; + +/* Check the global error status. */ + if ( !astOK ) return; + +/* Obtain the number of characters in the line. */ + l = *L; + +/* Negative values (or STATUS set) indicate end of input. If the value + is not negative, limit the number of characters to the length of + the character variable supplied. */ + if ( l >= 0 ) { + if ( l > LINE_length ) l = LINE_length; + +/* Create a dynamic string and fill it with the incoming data. Store + the resulting pointer, which will be picked up by the SourceWrap + function. */ + line_in = astString( LINE, l ); + } + ) +} + +void astSinkWrap_( void (* sink)( const char * ), const char *line, int *status ) { +/* +*+ +* Name: +* astSinkWrap + +* Purpose: +* Wrapper function to invoke a FORTRAN Channel sink function. + +* Type: +* Protected function. + +* Synopsis: +* void astSinkWrap( void (* sink)( const char * ), const char *line ) + +* Description: +* This function invokes the sink function whose pointer is +* supplied in order to write an output line to an external data +* store. + +* Parameters: +* sink +* Pointer to a sink function. This should result from a cast +* applied to a pointer to a function, with a single FORTRAN +* INTEGER error status argument, that returns void. This is +* the form of Channel sink function employed by the FORTRAN +* language interface to the AST library. +* line +* Pointer to a constant null-terminated string containing the +* line of output text. +*- +*/ + +/* Local Variables; */ + DECLARE_INTEGER(STATUS); /* FORTRAN error status variable */ + +/* Check the global error status. */ + if ( !astOK ) return; + +/* Store the pointer to the output text line in the (static) + "line_out" variable, where it will be accessed by the sink function + invoking AST_GETLINE. */ + line_out = line; + +/* Cast the sink function pointer to a pointer to the FORTRAN + subroutine and then invoke it. Transfer the AST error status to and + from the subroutine's error status argument. */ + STATUS = astStatus; + ( *(void (*)()) sink )( INTEGER_ARG(&STATUS) ); + astSetStatus( STATUS ); + +/* Clear the outgoing line pointer. */ + line_out = NULL; +} + +char *astSourceWrap_( const char *(* source)( void ), int *status ) { +/* +*+ +* Name: +* astSourceWrap + +* Purpose: +* Wrapper function to invoke a FORTRAN Channel source function. + +* Type: +* Protected function. + +* Synopsis: +* char *astSourceWrap( const char *(* source)( void ) ) + +* Description: +* This function invokes the source function whose pointer is +* supplied in order to read the next input line from an external +* data store. It then returns a pointer to a dynamic string +* containing a copy of the text that was read. + +* Parameters: +* source +* Pointer to a source function. This should result from a cast +* applied to a pointer to a function, with a single FORTRAN +* INTEGER error status argument, that returns void. This is +* the form of Channel source function employed by the FORTRAN +* language interface to the AST library. + +* Returned Value: +* A pointer to a dynamically allocated, null terminated string +* containing a copy of the text that was read. This string must be +* freed by the caller (using astFree) when no longer required. +* +* A NULL pointer will be returned if there is no more input text +* to read. + +* Notes: +* - A NULL pointer value will be returned if this function is +* invoked with the global error status set or if it should fail +* for any reason. +*- +*/ + +/* Local Variables: */ + DECLARE_INTEGER(STATUS); /* FORTRAN error status variable */ + char *result; /* Result pointer to return */ + +/* Initialise. */ + result = NULL; + +/* Check the global error status. */ + if ( !astOK ) return result; + +/* Initialise the incoming line pointer. */ + line_in = NULL; + +/* Cast the source function pointer to a pointer to the FORTRAN + subroutine and then invoke it. Transfer the AST error status to and + from the subroutine's error status argument. */ + STATUS = astStatus; + ( *(void (*)()) source )( INTEGER_ARG(&STATUS) ); + astSetStatus( STATUS ); + +/* This should result in a pointer to a dynamic string containing the + input text being stored in the (static) "line_in" variable as a + result of the source function invoking AST_PUTLINE. Save this + string pointer and clear the original. */ + result = line_in; + line_in = NULL; + +/* If an error occurred, free the returned string. */ + if ( ! astOK ) result = astFree( result ); + +/* Return the result. */ + return result; +} + +/* FORTRAN interface functions. */ +/* ============================ */ +/* These functions implement the remainder of the FORTRAN interface. */ +F77_INTEGER_FUNCTION(ast_channel)( void (* SOURCE)(), + void (* SINK)(), + CHARACTER(OPTIONS), + INTEGER(STATUS) + TRAIL(OPTIONS) ) { + GENPTR_CHARACTER(OPTIONS) + F77_INTEGER_TYPE(RESULT); + char *options; + const char *(* source)( void ); + int i; + void (* sink)( const char * ); + + astAt( "AST_CHANNEL", NULL, 0 ); + astWatchSTATUS( + +/* Set the source and sink function pointers to NULL if a pointer to + the null routine AST_NULL has been supplied. */ + source = (const char *(*)( void )) SOURCE; + if ( source == (const char *(*)( void )) F77_EXTERNAL_NAME(ast_null) ) { + source = NULL; + } + sink = (void (*)( const char * )) SINK; + if ( sink == (void (*)( const char * )) F77_EXTERNAL_NAME(ast_null) ) { + sink = NULL; + } + options = astString( OPTIONS, OPTIONS_length ); + +/* Truncate the options string to exlucde any trailing spaces. */ + astChrTrunc( options ); + +/* Change ',' to '\n' (see AST_SET in fobject.c for why). */ + if ( astOK ) { + for ( i = 0; options[ i ]; i++ ) { + if ( options[ i ] == ',' ) options[ i ] = '\n'; + } + } + RESULT = astP2I( astChannelFor( source, astSourceWrap, sink, astSinkWrap, + "%s", options ) ); + astFree( options ); + ) + return RESULT; +} + +F77_LOGICAL_FUNCTION(ast_isachannel)( INTEGER(THIS), + INTEGER(STATUS) ) { + GENPTR_INTEGER(THIS) + F77_LOGICAL_TYPE(RESULT); + + astAt( "AST_ISACHANNEL", NULL, 0 ); + astWatchSTATUS( + RESULT = astIsAChannel( astI2P( *THIS ) ) ? F77_TRUE : F77_FALSE; + ) + return RESULT; +} + +F77_INTEGER_FUNCTION(ast_read)( INTEGER(THIS), + INTEGER(STATUS) ) { + GENPTR_INTEGER(THIS) + F77_INTEGER_TYPE(RESULT); + + astAt( "AST_READ", NULL, 0 ); + astWatchSTATUS( + RESULT = astP2I( astRead( astI2P( *THIS ) ) ); + ) + return RESULT; +} + +F77_INTEGER_FUNCTION(ast_write)( INTEGER(THIS), + INTEGER(OBJECT), + INTEGER(STATUS) ) { + GENPTR_INTEGER(THIS) + GENPTR_INTEGER(OBJECT) + F77_INTEGER_TYPE(RESULT); + + astAt( "AST_WRITE", NULL, 0 ); + astWatchSTATUS( + RESULT = astWrite( astI2P( *THIS ), astI2P( *OBJECT ) ); + ) + return RESULT; +} + +F77_INTEGER_FUNCTION(ast_warnings)( INTEGER(THIS), + INTEGER(STATUS) ) { + GENPTR_INTEGER(THIS) + F77_INTEGER_TYPE(RESULT); + + astAt( "AST_WARNINGS", NULL, 0 ); + astWatchSTATUS( + RESULT = astP2I( astWarnings( astI2P( *THIS ) ) ); + ) + return RESULT; +} + + + |