#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 */
* 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 ));
#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
#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
#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 */
*-
*/
#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);
#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
*
* 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));
}
* 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 );
#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 */
#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 */
* 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;
}
#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,
#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
* 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;
#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;
#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) );
* 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 */
/* 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;
}
* {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 );
#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 );
* {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) ); )
}
#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)
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;
#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 );
* {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);
* 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;
}
* - 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'};
* 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 );
}
* {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);