示例#1
0
#include <stdlib.h>
#include <string.h>                    /* String handling */
#include <ctype.h>                     /* Character handling */

#ifndef VAX
#include <sys/types.h>
#include <sys/wait.h>
#include <unistd.h>
#endif


/*
 *  Body of code
 */
F77_SUBROUTINE(util_spool)( CHARACTER(file), CHARACTER(type), LOGICAL(del),
                            INTEGER(status) TRAIL(file) TRAIL(type) )
  {
  GENPTR_CHARACTER(file)
  GENPTR_CHARACTER(type)
  GENPTR_LOGICAL(del)
  GENPTR_INTEGER(status)

  int   cstatus;                        /* Child creation status */
  int   wstatus;                        /* Child creation status */
  char  *esym;                 		/* Environment variable name */
  char	*fname;				/* File to be spooled */
  char	*tname;				/* File type */
  char  *spcmd;                         /* Pointer to spool env variable */
  char  *argv[10];                      /* argv for execvp call */
  int   splen;				/* Length of *spcmd */
  int   i;                              /* Loop counter */
示例#2
0
 *        Changed to return array of doubles.
 *     {enter_changes_here}

 *-
 */
#include <string.h>
#include "cnf.h"
#include "f77.h"

F77_SUBROUTINE(hdr_ind)( CHARACTER(param),
                         CHARACTER(xname),
                         CHARACTER(item),
                         INTEGER(comp),
                         DOUBLE_ARRAY(value),
                         INTEGER(status)
                         TRAIL(param)
                         TRAIL(xname)
                         TRAIL(item) );

void hdrInD( char *param,
             char *xname,
             char *item,
             int comp,
             double *value,
             int *status ) {

  DECLARE_CHARACTER_DYN(fparam);
  DECLARE_CHARACTER_DYN(fxname);
  DECLARE_CHARACTER_DYN(fitem);

  F77_CREATE_CHARACTER(fparam,strlen( param ));
示例#3
0
#include <X11/Xlib.h>
#include <ctype.h>
#include <string.h>
#include "sae_par.h"
#include "gwm_err.h"
#include "gwm_for.h"
#include "cnf.h"
#include "f77.h"
#include "ems.h"

/******************************************************************************/

F77_SUBROUTINE(gwm_wsetc) ( CHARACTER(option), CHARACTER(value),
                            INTEGER(status) TRAIL(option) TRAIL(value) )

/*
*+
*  Name:
*     GWM_WSETC
*
*  Purpose:
*     Set an character string window option
*
*  Language:
*     C
*
*  Invocation:
*     CALL GWM_WSETC( OPTION, VALUE, STATUS )
*
*  Description:
*     The window options are used to control the characteristics of
示例#4
0
#include "f77.h"
#include "help.h"
#include "help1.h" /* Error constants */

/* Default Fortran STDIN unit */
#define F77UNIT 6

/* Global variables for the fortran function pointers that must be
   used from the C callbacks. This is not thread-safe as written.
   Mainly because Fortran itself is not thread-safe so the extra
   effort to make the fortran interface thread-safe is not warranted
   (and HLP is not thread-safe).
 */

static void (*gl_nametr)( INTEGER(kmd), CHARACTER(instr), CHARACTER(outstr),
		       INTEGER(jstat) TRAIL(instr) TRAIL(outstr) );
static F77_INTEGER_TYPE (*gl_outsub)( CHARACTER(outstr) TRAIL(outstr) );
static F77_INTEGER_TYPE (*gl_insub)( CHARACTER(string), CHARACTER(prompt),
				  INTEGER(l) TRAIL(string) TRAIL(prompt) );

/* These are the C default callbacks with a Fortran interface */

F77_SUBROUTINE(hlp_nametr)( INTEGER(kmd), CHARACTER(instr), CHARACTER(outstr),
			    INTEGER(jstat) TRAIL(instr) TRAIL(outstr) );
F77_INTEGER_FUNCTION(hlp_outsub)( CHARACTER(outstr) TRAIL(outstr) );
F77_INTEGER_FUNCTION(hlp_insub)( CHARACTER(string), CHARACTER(prompt),
				 INTEGER(l) TRAIL(string) TRAIL(prompt) );


/* These are the C callback routines that have to be registered with
   hlpHelp and hlpCreh. They translate the arguments into fortran
示例#5
0
#if STDC_HEADERS
#  include <string.h>
#  include <time.h>		 /* C time library			    */
/* if we start to use sys/time.h, see autoconf AC_HEADER_TIME */
#endif


#include "f77.h"		 /* C - Fortran interface		    */
#include "sae_par.h"		 /* ADAM constants			    */

/* Number of characters mandated by ctime for buffer space */
#define SZ_CTIME 26

F77_SUBROUTINE(psx_ctime)( INTEGER(nticks), CHARACTER(string),
                           INTEGER(status) TRAIL(string) )
{

/* Pointers to Arguments:						    */

   GENPTR_INTEGER(nticks)
   GENPTR_CHARACTER(string)
   GENPTR_INTEGER(status)

/* Local Variables:							    */

   time_t timep;                 /* Local version of nticks */
   int i;			 /* Loop counter			    */
   char time_s[SZ_CTIME+1];	 /* The string returned by asctime	    */
#if HAVE_CTIME && !HAVE_CTIME_R
   char * temps;                 /* Pointer to static string given by ctime */
示例#6
0
 *-
 */
#include <string.h>
#include <stdlib.h>
#include "cnf.h"
#include "f77.h"
#include "img1.h"

F77_SUBROUTINE(hdr_outl)( CHARACTER(param),
                          CHARACTER(xname),
                          CHARACTER(item),
                          CHARACTER(commen),
                          LOGICAL_ARRAY(value),
                          INTEGER(status)
                          TRAIL(param)
                          TRAIL(xname)
                          TRAIL(item)
                          TRAIL(commen) );

void hdrOutL( char *param,
              char *xname,
              char *item,
              char *commen,
              int *value,
              int *status ) {

  DECLARE_CHARACTER_DYN(fparam);
  DECLARE_CHARACTER_DYN(fxname);
  DECLARE_CHARACTER_DYN(fitem);
  DECLARE_CHARACTER_DYN(fcommen);
示例#7
0
#include "star/hds.h"
#include "star/hds_fortran.h"
#include "f77.h"
#include "ast.h"
#include "sae_par.h"

F77_SUBROUTINE(atl_ky2hd)( INTEGER(KEYMAP), CHARACTER(LOC), INTEGER(STATUS)
                           TRAIL(LOC) ) {
/*
*+
*  Name:
*     ATL_KY2HD

*  Purpose:
*     Converts an AST KeyMap into an HDS structure.

*  Language:
*     C, designed to be called from Fortran.

*  Invocation:
*     CALL ATL_KY2HD( KEYMAP, LOC, STATUS )

*  Description:
*     This routine copies the contents of an AST KeyMap into a supplied
*     HDS structure.

*  Arguments:
*     KEYMAP = INTEGER (Given)
*        The AST KeyMap identifier.
*     LOC = CHARACTER * (DAT__SZLOC) (Given)
*        A locator for the HDS object into which the KeyMap contents
示例#8
0
文件: hello_c.c 项目: alucas/StarPU
 *
 * 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 2.1 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 in COPYING.LGPL for more details.
 */

#include <stdlib.h>
#include <stdio.h>
#include <stdint.h>

#include <f77.h>

#define fline_length 80

extern F77_SUBROUTINE(hellosub)( INTEGER(i) TRAIL(line) );


void dummy_c_func_(INTEGER(i))
{
	fprintf(stderr, "i = %d\n", *INTEGER_ARG(i));

	F77_CALL(hellosub)(INTEGER_ARG(i)TRAIL_ARG(fline));
}
示例#9
0
*     23-JUL-2009 (TIMJ):
*        Use new API.
*     {enter_changes_here}

*  Bugs:
*     {note_any_bugs_here}

*-
*/

#include "f77.h"
#include "merswrap.h"
#include "mers_f77.h"

F77_SUBROUTINE(msg_iflev)( INTEGER(FILTER), CHARACTER(STRING),
                           INTEGER(STATUS) TRAIL(STRING) ) {
  msglev_t filter;
  int status;
  char *string = NULL;

  F77_IMPORT_INTEGER( *STATUS, status );

  /* Decide whether we need to allocate a string buffer.
     Do not do so if the Fortran string is a single character. */
  if ( STRING_length > 1 ) {
    string = starMallocAtomic( MSG__SZLEV );
    string[0] = '\0';
  }

  filter = msgIflev( string, &status );
示例#10
0
#if defined(mips)		/* mips			    */
#if !defined(__STDC__)
#undef  F77_EXTERNAL_NAME
#define F77_EXTERNAL_NAME(X) X/**/_
#undef  TRAIL
#define TRAIL(X) ,int X/**/_length
#endif  /* of non ANSI redefinitions			    */
#endif

#endif


F77_SUBROUTINE(genv)( CHARACTER(name),
                      CHARACTER(trans),
                      INTEGER(status)
                      TRAIL(name)
                      TRAIL(trans)
                          )
{

/* Pointers to Arguments:						    */

   GENPTR_CHARACTER(name)
   GENPTR_CHARACTER(trans)
   GENPTR_INTEGER(status)

/* Local Variables:							    */

   char *temp_name;		 /* Pointer to local copy of name 	    */
   char *ptr;			 /* Pointer to environment variable	    */
示例#11
0
#if HAVE_GETCWD
#  define USE_GETCWD 1
#elif HAVE_GETWD
#  define USE_GETWD 1
#else
   error Unable to find either getwd or getcwd
#endif

#if USE_GETWD
#  include <sys/param.h>
#endif

#include <string.h>
#include <errno.h>

F77_SUBROUTINE(psx_getcwd)( CHARACTER(CWD), INTEGER(STATUS) TRAIL(CWD) )
{
  GENPTR_CHARACTER(CWD)
  GENPTR_INTEGER(STATUS)

  int  err;        /* Local copy of errno */
  char * result;   /* Result of getcwd/getwd */
#if USE_GETCWD
  size_t size;     /* Size of string for getcwd */
  char * tempbuf = NULL;      /* Local copy of result */
#else
  char tempbuf[MAXPATHLEN];   /* somewhere to store the result from getwd */
#endif

  if (*STATUS != SAI__OK) {
    cnfExprt( " ", CWD, CWD_length ); /* initialise result */
示例#12
0
*  Bugs:
*     {note_any_bugs_here}

*-
*/

#include <unistd.h>
#include <errno.h>

#include "sae_par.h"
#include "f77.h"
#include "psx_err.h"
#include "psx1.h"
#include "ems.h"

F77_SUBROUTINE(psx_chdir)( CHARACTER(DIR), INTEGER(STATUS) TRAIL(DIR))
{

    GENPTR_CHARACTER(DIR)
    GENPTR_INTEGER(STATUS)
    int err;             /* Local errno */
    char * dir_c;        /* Local copy of the string in C format */
    int lstat;           /* Status from chdir */

    if (*STATUS != SAI__OK) return;

    if ( DIR_length == 0 ) {
        err = EINVAL;
        goto ERROR;
    }
示例#13
0
#include <stdlib.h>
#include <string.h>
#include "tcltalk.h"
#include "ccdaux.h"

   F77_SUBROUTINE(ccd1_tcurs)( CHARACTER_ARRAY(ndfnms), INTEGER(nndf),
                               CHARACTER(sname), CHARACTER(domain),
                               INTEGER_ARRAY(idi), DOUBLE_ARRAY(xipos),
                               DOUBLE_ARRAY(yipos), INTEGER(nipos),
                               LOGICAL(verbos),
                               DOUBLE_ARRAY(percnt), DOUBLE(zoom),
                               INTEGER(maxcanv), INTEGER(windim),
                               CHARACTER(mstyle), LOGICAL(centrd),
                               POINTER(ipio), POINTER(ipxo), POINTER(ipyo),
                               INTEGER(nopos), INTEGER(status)
                               TRAIL(ndfnms) TRAIL(sname) TRAIL(domain)
                               TRAIL(mstyle) ) {
/*
*+
*  Name:
*     CCD1_TCURS

*  Purpose:
*     Harness Tcl code to get points interactively from a displayed NDF.

*  Language:
*     ANSI C.

*  Invocation:
*     CALL CCD1_TCURS( NDFNMS, NNDF, SNAME, DOMAIN, IDI, XIPOS, YIPOS,
*                      NIPOS, VERBOS, PERCNT, ZOOM, MAXCANV, WINDIM,
示例#14
0
#include <stdio.h>
#include "cnf.h"
#include "f77.h"

extern FILE *fd;   /*  A pointer to the FILE structure identifying the open file */



F77_INTEGER_FUNCTION(con_copen)( CHARACTER(name), CHARACTER(access) TRAIL(name)
                       TRAIL(access) ){
/*
 *  Name:
 *    con_copen

 *  Purpose:
 *    Provides access to the C "fopen" function from Fortran.

 *  Invocation:
 *    ISTAT = CON_COPEN( NAME, ACCESS )

 *  Arguments:
 *    NAME = CHARACTER * ( * ) (Given)
 *       The name of the file to open
 *    ACCESS = CHARACTER * ( * ) (Given)
 *       The access code with which to open the file.  This should be a
 *       string acceptable to the C fopen function (eg, "w", "w+", etc.)

 *  Function Value:
 *    ISTAT = INTEGER (Returned)
 *       Status: 0 = failure, 1 = success
示例#15
0
*  Copyright:
*     Copyright (C) 2006 Particle Physics & Astronomy Research Council.
*     All Rights Reserved.

 *  Authors:

 *-
*/
#include "ems.h"                       /* ems_ function prototypes */
#include "ems_par.h"                   /* EMS constants            */
#include "f77.h"                       /* CNF macros and prototypes */

#include "ems_f77.h"

F77_SUBROUTINE(ems_eload) ( CHARACTER(param), INTEGER(parlen), CHARACTER(opstr),
            INTEGER(oplen), INTEGER(status) TRAIL(param) TRAIL(opstr)) {

   GENPTR_CHARACTER(param)
   GENPTR_INTEGER(parlen)
   GENPTR_CHARACTER(opstr)
   GENPTR_INTEGER(oplen)
   GENPTR_INTEGER(status)

   char str1[EMS__SZMSG+1];
   char str2[EMS__SZMSG+1];

   emsEload(str1, parlen, str2, oplen, status);
   cnfExprt( str1, param, param_length );
   cnfExprt( str2, opstr, opstr_length );

   return;
示例#16
0
#include "ems.h"
#include "ems_par.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>

/* Global Constants: */
#include "subpar_err.h"

/* Function Definition: */
F77_SUBROUTINE(subpar_fifil)(CHARACTER(path), CHARACTER(name), CHARACTER(ext),
                             CHARACTER(acc), CHARACTER(file), INTEGER(ind),
                             INTEGER(status) TRAIL(path) TRAIL(name)
                             TRAIL(ext) TRAIL(acc) TRAIL(file) )
{
GENPTR_CHARACTER(path)
GENPTR_CHARACTER(name)
GENPTR_CHARACTER(ext)
GENPTR_CHARACTER(acc)
GENPTR_CHARACTER(file)

/* Local Variables:
*/
char *path_c;
char *name_c;
char *ext_c;
char *acc_c;
char *tmpext;
示例#17
0
#include "sae_par.h"
#include "f77.h"
#include "psx_err.h"
#include "psx1.h"

#include <wordexp.h>

typedef struct {
  size_t nextpos;   /* Next position to read */
  wordexp_t pwordexp;
} Context;

F77_SUBROUTINE(psx_wordexp)( CHARACTER(WORDS), INTEGER(CONTEXT),
                             CHARACTER(EXPAN), INTEGER(STATUS)
                             TRAIL(WORDS) TRAIL(EXPAN) ) {
  GENPTR_CHARACTER(WORDS)
  GENPTR_CHARACTER(EXPAN)
  GENPTR_INTEGER(STATUS)
  GENPTR_INTEGER(CONTEXT)

  Context *ContextPtr = NULL;  /* Some where to put the result */

  if (*STATUS != SAI__OK) return;

  if (*CONTEXT == 0) {
    char * words = NULL;
    int retval = 0;

    /* first time through - get some nice CNF memory for the result */
    ContextPtr = cnfMalloc( sizeof(*ContextPtr) );
示例#18
0
 *  for the pipe that reads from the 'ls' process, and the string used
 *  to remember any directory specification output by the 'ls' process,
 *  when a number of directories are being listed.  One of these is
 *  allocated when Context is passed as zero, and its address is then
 *  the quantity returned in Context.
 */

typedef struct ContextStruct {
    int Fds[2];          /* Input and output file descriptors for the pipe */
    char Directory[DIRECTORY_LEN];
    /* Last directory spec output by 'ls' process */
} ContextStruct;


F77_INTEGER_FUNCTION(find_file)( CHARACTER(FileSpec), CHARACTER(FileName),
                                 POINTER(Context) TRAIL(FileSpec) TRAIL(FileName) )
{
    GENPTR_CHARACTER(FileSpec) /* Pointer to file specification. Length is
                                FileSpec_length */
    GENPTR_CHARACTER(FileName) /* Pointer to string to return file name in
                                Length is FileName_length */
    GENPTR_POINTER(Context)    /* Used to remember context of search */


    /*  Local variables  */
    int SpecLength;                /* Number of bytes in FileSpec - FileSpec_length*/
    int NameLength;                /* Number of bytes in FileName - FileName_length*/
    int Bytes;            /* Number of bytes read from pipe */
    char Char;            /* Byte read from pipe */
    int ColonIndex;       /* Index in Line of last colon */
    ContextStruct *ContextPtr; /* Pointer to current context information */
示例#19
0
/* 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 "mapping.h"             /* C interface to the Mapping class */
#include "frame.h"               /* C interface to the Frame class */


F77_INTEGER_FUNCTION(ast_convert)( INTEGER(FROM),
                                   INTEGER(TO),
                                   CHARACTER(NAMELIST),
                                   INTEGER(STATUS)
                                   TRAIL(NAMELIST) ) {
   GENPTR_INTEGER(FROM)
   GENPTR_INTEGER(TO)
   GENPTR_INTEGER(NAMELIST)
   F77_INTEGER_TYPE(RESULT);
   char *namelist;

   astAt( "AST_CONVERT", NULL, 0 );
   astWatchSTATUS(
      namelist = astString( NAMELIST, NAMELIST_length );
      RESULT = astP2I( astConvert( astI2P( *FROM ), astI2P( *TO ),
                                   namelist ) );
      namelist = astFree( namelist );
   )
   return RESULT;
}
示例#20
0
*     {note_any_bugs_here}

*-
*/

#include "f77.h"
#include "mers_f77.h"
#include "merswrap.h"
#include "msg_par.h"
#include "err_par.h"

F77_SUBROUTINE(msg_outif)( INTEGER(PRIOR),
                           CHARACTER(PARAM),
                           CHARACTER(TEXT),
                           INTEGER(STATUS)
                           TRAIL(PARAM)
                           TRAIL(TEXT) ) {
  char param[ERR__SZPAR+1];
  char text[MSG__SZMSG+1];
  int prior;
  int status;

  cnfImpn( PARAM, PARAM_length, ERR__SZPAR, param );
  cnfImpn( TEXT, TEXT_length, MSG__SZMSG, text );

  F77_IMPORT_INTEGER( *STATUS, status );
  F77_IMPORT_INTEGER( *PRIOR, prior );

  msgOutif( prior, param, text, &status );

  F77_EXPORT_INTEGER( status, *STATUS );
示例#21
0
#include "ems.h"                 /* ems prototypes */

/* HDS Fortran Locator export/import routines */
#include "star/hds_fortran.h"

/* Internal header files. */
#include "hdspar.h"                 /* HDSPAR_ library public interface */

/* Wrapper function implementations. */
/* ================================= */

F77_SUBROUTINE(dat_assoc)( CHARACTER(PARAM),
                           CHARACTER(ACCESS),
                           CHARACTER(LOC),
                           INTEGER(STATUS)
                           TRAIL(PARAM)
                           TRAIL(ACCESS)
                           TRAIL(LOC) );

void datAssoc( const char *param,
               const char *access,
               HDSLoc **loc,
               int *status ) {

DECLARE_CHARACTER_DYN(PARAM);
DECLARE_CHARACTER_DYN(ACCESS);
DECLARE_CHARACTER(LOC,DAT__SZLOC);
DECLARE_INTEGER(STATUS);

   F77_CREATE_EXPORT_CHARACTER( param, PARAM );
   F77_CREATE_EXPORT_CHARACTER( access, ACCESS );
示例#22
0
*     {enter_new_authors_here}

*  History:
*     4-OCT-1989 (PCTR):
*        Original version, based upon code for PONGO.
*     15-DEC-1989 (PCTR):
*        Converted to call EMS_FIOER.
*     {enter_changes_here}

*  Bugs:
*     {note_any_bugs_here}

*-
*/

#include "f77.h"
#include "mers_f77.h"

/* EMS does not publish the fortran prototype */
F77_SUBROUTINE (ems_fioer)( CHARACTER(token), INTEGER(iostat) TRAIL(token) );

F77_SUBROUTINE(err_fioer)( CHARACTER(TOKEN),
                           INTEGER(IOSTAT)
                           TRAIL(TOKEN) ) {

  /* Note that we pass this directly to the EMS Fortran wrapper and so
     do not need to convert strings or other arguments */
  F77_LOCK( F77_CALL(ems_fioer)( TOKEN, IOSTAT TRAIL_ARG(TOKEN) ); )

}
示例#23
0
#include <string.h>		 /* String handling library		    */
#include <sys/utsname.h>
#endif

#include "f77.h"		 /* C - Fortran interface		    */
#include "psx1.h"		 /* Internal PSX routines		    */
#include "sae_par.h"		 /* ADAM constants			    */


F77_SUBROUTINE(psx_uname)( CHARACTER(sysname),
                           CHARACTER(nodename),
                           CHARACTER(release),
                           CHARACTER(version),
                           CHARACTER(machine),
                           INTEGER(status)
                           TRAIL(sysname)
                           TRAIL(nodename)
                           TRAIL(release)
                           TRAIL(version)
                           TRAIL(machine)
                         )
{

/* Pointers to Arguments:						    */

   GENPTR_CHARACTER(sysname)
   GENPTR_CHARACTER(nodename)
   GENPTR_CHARACTER(release)
   GENPTR_CHARACTER(version)
   GENPTR_CHARACTER(machine)
   GENPTR_INTEGER(status)
示例#24
0
   for ( ; i < dest_len; i++ ) dest_f[i] = ' ';
}


F77_SUBROUTINE(dgels)( CHARACTER(TRANS),
                       INTEGER(M),
                       INTEGER(N),
                       INTEGER(NRHS),
                       DOUBLE_ARRAY(A),
                       INTEGER(LDA),
                       DOUBLE_ARRAY(B),
                       INTEGER(LDB),
                       DOUBLE_ARRAY(WORK),
                       INTEGER(LWORK),
                       INTEGER(INFO)
                       TRAIL(TRANS) );

void call_dgels(char *trans, int m, int n, int nrhs, 
                double *a, int lda, double *b, int ldb, 
                double *work, int lwork, int *info) {
   DECLARE_CHARACTER( TRANS, 1 );
   DECLARE_INTEGER(M);
   DECLARE_INTEGER(N);
   DECLARE_INTEGER(NRHS);
   DECLARE_INTEGER(LDA);
   DECLARE_INTEGER(LDB);
   DECLARE_INTEGER(LWORK);
   DECLARE_INTEGER(INFO);

   slaStringExport(trans, TRANS, 1);
   M = m;
示例#25
0
#include <string.h>             /* String handling */

/* External interface header files. */
#include "f77.h"                /* C<-->Fortran interface macros */
#include "dat_par.h"            /* Hierarchical Data System (HDS) */

/* Internal header files. */
#include "ndf.h"                /* NDF_ library public interface */

/* Wrapper function implementations. */
/* ================================= */
F77_SUBROUTINE(ndf_assoc)( CHARACTER(param),
                           CHARACTER(mode),
                           INTEGER(indf),
                           INTEGER(status)
                           TRAIL(param)
                           TRAIL(mode) );

void ndfAssoc( const char *param,
               const char *mode,
               int *indf,
               int *status ) {

DECLARE_CHARACTER_DYN(fparam);
DECLARE_CHARACTER_DYN(fmode);
DECLARE_INTEGER(findf);
DECLARE_INTEGER(fstatus);

   F77_CREATE_EXPORT_CHARACTER( param, fparam );
   F77_CREATE_EXPORT_CHARACTER( mode, fmode );
   F77_EXPORT_INTEGER( *status, fstatus );
示例#26
0
*     {enter_further_changes_here}

*  Bugs:
*     {note_any_bugs_here}

*-
*/

#include <inttypes.h>

#include "f77.h"
#include "merswrap.h"
#include "star/mem.h"
#include "mers_f77.h"

F77_SUBROUTINE(msg_setk)( CHARACTER(TOKEN), INTEGER8(IVALUE) TRAIL(TOKEN) ) {

      int64_t ivalue;
      char *token;

      GENPTR_CHARACTER(TOKEN);

      F77_IMPORT_INTEGER8( *IVALUE, ivalue );
      token = starMallocAtomic( TOKEN_length + 1 );
      F77_IMPORT_CHARACTER( TOKEN, TOKEN_length, token );

/*  Construct the message token string. */
      msgSetk( token, ivalue );

      starFree(token);
示例#27
0
*     Foundation, Inc., 51 Franklin Street,Fifth Floor, Boston, MA
*     02110-1301, USA

*  Copyright:
*     Copyright (C) 2006 Particle Physics & Astronomy Research Council.
*     All Rights Reserved.

 *  Authors:

 *-
*/
#include "ems.h"                       /* ems_ function prototypes */
#include "ems_sys.h"                   /* EMS internal constants */
#include "f77.h"                       /* CNF macros and prototypes */

#include "ems_f77.h"

F77_SUBROUTINE(ems_facer) ( CHARACTER(token), INTEGER(fstat) TRAIL(token) )
{
    char ctok[EMS__SZNAM+1];      /* Imported token name */

    GENPTR_CHARACTER(token)
    GENPTR_INTEGER(fstat)

    cnfImpn( token, token_length, EMS__SZNAM, ctok );

    emsFacer( ctok, *fstat );

    return;
}
示例#28
0
*     -  Does not use TERMIOS or TERMCAP databases, so may not work on
*     non-ANSI terminals. The escape sequences used are hard-wired into
*     the following code.
*     {note_any_bugs_here}

*-
*/

#include <fcntl.h>
#include <sys/termios.h>
#include <string.h>
#include "f77.h"

F77_INTEGER_FUNCTION(rdkbd2)( CHARACTER(string), CHARACTER(pbuf),
                              INTEGER(lprm), INTEGER(term), INTEGER(lenout)
                              TRAIL(string) TRAIL(pbuf) ){

GENPTR_CHARACTER(string)
GENPTR_CHARACTER(pbuf)
GENPTR_INTEGER(lprm)
GENPTR_INTEGER(term)
GENPTR_INTEGER(lenout)

      int fd,i,j,inov;
      char buf[3];

      char ret[2]={10,13};
      char del[4]={8,27,'[','P'};
      char ins[3]={27,'[','@'};
      char left[3]={27,'[','D'};
      char right[3]={27,'[','C'};
示例#29
0
*     23-JUL-2008 (TIMJ):
*        Now written in C to call errSyser
*     {enter_changes_here}

*  Bugs:
*     {note_any_bugs_here}

*-
*/

#include "f77.h"
#include "merswrap.h"
#include "mers_f77.h"

F77_SUBROUTINE(err_facer)( CHARACTER(TOKEN),
                           INTEGER(STATUS)
                           TRAIL(TOKEN) ) {

  char *token;
  int status;

  GENPTR_CHARACTER(TOKEN);

  token = starMallocAtomic( TOKEN_length + 1 );
  F77_IMPORT_CHARACTER( TOKEN, TOKEN_length, token );
  F77_IMPORT_INTEGER( *STATUS, status );

  errFacer( token, status );
  starFree( token );
}
示例#30
0
 *     {enter_new_authors_here}

 *  History:
 *     17-May-1996 (fcwrap):
 *        Original version
 *     {enter_changes_here}

 *-
 */
#include "cnf.h"
#include "f77.h"
#include "string.h"

F77_SUBROUTINE(img_delet)( CHARACTER(param),
                           INTEGER(status)
                           TRAIL(param) );

void imgDelet( char *param,
               int *status ) {

  DECLARE_CHARACTER_DYN(fparam);

  F77_CREATE_CHARACTER(fparam,strlen( param ));
  cnf_exprt( param, fparam, fparam_length );

  F77_LOCK( F77_CALL(img_delet)( CHARACTER_ARG(fparam),
                       INTEGER_ARG(status)
                       TRAIL_ARG(fparam) ); )

  F77_FREE_CHARACTER(fparam);