summaryrefslogtreecommitdiffstats
path: root/ast/fchannel.c
diff options
context:
space:
mode:
Diffstat (limited to 'ast/fchannel.c')
-rw-r--r--ast/fchannel.c473
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;
+}
+
+
+