upgrade ast 8.7.1

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;
+}
+
+
+