1 /* 2 *+ 3 * Name: 4 * f77.h and cnf.h 5 6 * Purpose: 7 * C - FORTRAN interace macros and prototypes 8 9 * Language: 10 * C (part ANSI, part not) 11 12 * Type of Module: 13 * C include file 14 15 * Description: 16 * For historical reasons two files, F77.h and cnf.h are required 17 * but the have now been combined and for new code, only one is 18 * necessary. 19 * 20 * This file defines the macros needed to write C functions that are 21 * designed to be called from FORTRAN programs, and to do so in a 22 * portable way. Arguments are normally passed by reference from a 23 * FORTRAN program, and so the F77 macros arrange for a pointer to 24 * all arguments to be available. This requires no work on most 25 * machines, but will actually generate the pointers on a machine 26 * that passes FORTRAN arguments by value. 27 28 * Notes: 29 * - Macros are provided to handle the conversion of logical data 30 * values between the way that FORTRAN represents a value and the 31 * way that C represents it. 32 * - Macros are provided to convert variables between the FORTRAN and 33 * C method of representing them. In most cases there is no 34 * conversion required, the macros just arrange for a pointer to 35 * the FORTRAN variable to be set appropriately. The possibility that 36 * FORTRAN and C might use different ways of representing integer 37 * and floating point values is considered remote, the macros are 38 * really only there for completeness and to assist in the automatic 39 * generation of C interfaces. 40 * - For character variables the macros convert between 41 * the FORTRAN method of representing them (fixed length, blank 42 * filled strings) and the C method (variable length, null 43 * terminated strings) using calls to the CNF functions. 44 45 * Implementation Deficiencies: 46 * - The macros support the K&R style of function definition, but 47 * this file may not work with all K&R compilers as it contains 48 * "#if defined" statements. These could be replaced with #ifdef's 49 * if necessary. This has not been done as is would make the code 50 * less clear and the need for support for K&R sytle definitions 51 * should disappear as ANSI compilers become the default. 52 53 * Copyright: 54 * Copyright (C) 1991, 1993 Science & Engineering Research Council. 55 * Copyright (C) 2006 Particle Physics and Astronomy Research Council. 56 * Copyright (C) 2007,2008 Science and Technology Facilities Council. 57 * All Rights Reserved. 58 59 * Licence: 60 * This program is free software; you can redistribute it and/or 61 * modify it under the terms of the GNU General Public License as 62 * published by the Free Software Foundation; either version 2 of 63 * the License, or (at your option) any later version. 64 * 65 * This program is distributed in the hope that it will be 66 * useful,but WITHOUT ANY WARRANTY; without even the implied 67 * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 68 * PURPOSE. See the GNU General Public License for more details. 69 * 70 * You should have received a copy of the GNU General Public License 71 * along with this program; if not, write to the Free Software 72 * Foundation, Inc., 51 Franklin Street,Fifth Floor, Boston, MA 73 * 02110-1301, USA 74 75 * Authors: 76 * PMA: Peter Allan (Starlink, RAL) 77 * AJC: Alan Chipperfield (Starlink, RAL) 78 * TIMJ: Tim Jenness (JAC) 79 * PWD: Peter W. Draper (JAC, Durham University) 80 * {enter_new_authors_here} 81 82 * History: 83 * 23-MAY-1991 (PMA): 84 * Original version. 85 * 19-JUN-1991 (PMA): 86 * Removed VMS versions of IM(EX)PORT_LOGICAL macros that tried 87 * to convert data representations. 88 * 24-JUN-1991 (PMA): 89 * Changed the names of IMPORT macros to GENPTR. 90 * Removed the EXPORT macros. 91 * 27-JUN-1991 (PMA): 92 * Modified DECstation specific stuff to allow use of the c89 93 * compiler. 94 * 8-JUL-1991 (PMA): 95 * Added macros to call FORTRAN from C. 96 * 16-OCT-1991 (PMA): 97 * Remove type_ARRAY2 definitions. 98 * Remove the length argument from CHARACTER_ARRAY and the 99 * dimension specifier from GENPTR_type_ARRAY. 100 * Add extra brackets to F77_ISFALSE and F77_ISTRUE. 101 * 25-OCT-1991 (PMA): 102 * Changed "if defined(sun4)" to "if defined(sun)" 103 * 2-JUN-1992 (PMA): 104 * Changed "if defined(mips)" to "if defined(ultrix)" to prevent 105 * those definitions being used on a Silicon Graphics machine. 106 * 11-JUN-1992 (PMA): 107 * Changed "if defined(ultrix)" back to "if defined(mips)" so that 108 * it still works on OSF/1 on a DECstation. 109 * Add support for general non-ANSI compilers, but not basic K&R 110 * ones. 111 * 12-JUN-1992 (PMA): 112 * Change declaration of dummy scalar arguments to be const 113 * pointers. Change declaration of dummy array arguments to be 114 * const pointers. 115 * 5-JAN-1993 (PMA): 116 * Changed "if defined(mips)" so that it will recognise a 117 * DECstation running Ultrix or OSF/1, but not a Silicon Graphics 118 * workstation. 119 * Change the definition of F77_BYTE_TYPE to add "signed". 120 * Redefine this on VMS where signed is invalid syntax. 121 * Add new types of UBYTE and UWORD. 122 * 8-JAN-1993 (PMA): 123 * Fix bug in the definition of CHARACTER_RETURN_VALUE. There was 124 * an extraneous space. 125 * Add a macro F77_POINTER_TYPE and use it to define POINTER. 126 * 13-JAN-1993 (PMA): 127 * Start to add support for K&R function definitions. These are 128 * done on a per machine basis. 129 * 16-APR-1993 (PMA): 130 * Change the definition of F77_POINTER_TYPE from int to unsigned 131 * int. 132 * 7-MAY-1993 (PMA): 133 * Change from using a null comment as a token concatenation 134 * operator to using the internal macro _f77_x on non-ANSI 135 * systems. 136 * 10-MAY-1993 (PMA): 137 * Finish adding K&R support. This will form version 2.0 of F77. 138 * 10-MAY-1993 (PMA): 139 * Add support for Alpha OSF/1. 140 * 9-JUL-1993 (PMA): 141 * Add further POINTER macros: POINTER_ARRAY, 142 * GENPTR_POINTER_ARRAY, DECLARE_POINTER, DECLARE_POINTER_ARRAY, 143 * POINTER_ARG, POINTER_ARRAY_ARG, F77_POINTER_FUNCTION, 144 * KR_POINTER_ARRAY. 145 * 24-AUG-1993 (PMA): 146 * Add const to the VMS definitions of CHARACTER and CHARACTER_ARRAY. 147 * 3-NOV-1993 (PMA): 148 * Remove K&R stuff to a separate file. 149 * Released on Unix as version 2.0 of CNF. 150 * 11-NOV-1993 (PMA): 151 * Return to using the null comment to concatenate text on non-ANSI 152 * systems as _f77_x caused problems with the c89 -common flag on 153 * DECstations. 154 * 23-JAN-1996 (AJC): 155 * Add SUBROUTINE, type_FUNCTION, SUBROUTINE_ARG, 156 * type_FUNCTION_ARG, GENPTR_SUBROUTINE and GENPTR_type_FUNCTION 157 * required for passed subroutine and function name. 158 * 29-JAN-1996 (AJC): 159 * Add the dynamic CHARACTER_ macros 160 * and CHARACTER_ARG_TYPE 161 * 22-FEB-1996 (AJC): 162 * Add CHARACTER_RETURN_ARG 163 * 23-MAY-1996 (AJC): 164 * Add DECLARE_CHARACTER_ARRAY_DYN 165 * F77_CREATE_CHARACTER_ARRAY 166 * F77_CHARACTER_ARG_TYPE 167 * 14-JUN-1996 (AJC): 168 * Add DECLARE_LOGICAL_ARRAY_DYN 169 * F77_CREATE_LOGICAL_ARRAY 170 * 21-JUN-1996 (AJC): 171 * Add cast to _ARRAY_ARGs to allow multidimensional arrays 172 * 17-MAR-1998 (AJC): 173 * Add DECLARE, CREATE and FREE dynamic array macros for all types 174 * Changed CREATE_CHARACTER_ARRAY and CREATE_LOGICAL_ARRAY to use 175 * number of elements rather than dimensions. 176 * Add IMPORT, EXPORT and ASSOC macros 177 * 22-JUL-1998 (AJC): 178 * Combined F77.h and cnf.h 179 * 23-SEP-1998 (AJC): 180 * Input strings for cnf -> const char * 181 * Input int arrays for cnf -> const int * 182 * 4-NOV-1998 (AJC): 183 * Bring cnf prototypes in line with .c routines 184 * 8-FEB-1999 (AJC): 185 * Added cnf_mem stuff 186 * 9-FEB-1999 (AJC): 187 * Use cnf_cptr/fptr for IMPORT/EXPORT_POINTER 188 * 16-FEB-1999 (AJC): 189 * Added missing cnf_fptr prototype 190 * 23-JUN-1999 (AJC): 191 * Change cnf_name to cnfName 192 * and add macros for cnf_name 193 * 1-DEC-1999 (AJC): 194 * Add define cnf_free 195 * 7-JAN-2000 (AJC): 196 * Correct omission of F77_ASSOC_UBYTE_ARRAY 197 * Correct F77_EXPORT_UWORD_ARRAY 198 * 25-AUG-2005 (TIMJ): 199 * Add cnfInitRTL 200 * 23-FEB-2006 (TIMJ): 201 * Add cnfRealloc 202 * Use starMalloc rather than malloc in F77_CREATE_POINTER_ARRAY 203 * (since it needs to match what goes on in cnfFree) 204 * 21-JUN-2006 (PWD): 205 * Changed to use a different return type for REAL functions. This 206 * effects g77 under 64-bit, when the f2c bindings expect the return 207 * value of a REAL function to be a double, not a float. 208 * 25-SEP-2006 (PWD): 209 * Introduced F77_CREATE_IMPORT_CHARACTER. Match length of 210 * F77_CREATE_CHARACTER to result from cnfCref. 211 * 13-JUL-2007 (PWD): 212 * Parameterise the type of Fortran character string lengths. Can 213 * be long. 214 * 7-OCT-2008 (TIMJ): 215 * Initialise pointers. 216 * 11-MAY-2011 (DSB): 217 * Added F77_LOCK 218 * {enter_further_changes_here} 219 * 220 221 * Bugs: 222 * {note_any_bugs_here} 223 224 *- 225 ------------------------------------------------------------------------------ 226 */ 227 #if !defined(CNF_MACROS) 228 #define CNF_MACROS 229 230 #include <stdlib.h> 231 #include <string.h> 232 /* This initial sections defines values for all macros. These are the */ 233 /* values that are generally appropriate to an ANSI C compiler on Unix. */ 234 /* For macros that have different values on other systems, the macros */ 235 /* should be undefined and then redefined in the system specific sections. */ 236 /* At the end of this section, some macros are redefined if the compiler */ 237 /* is non-ANSI. */ 238 239 #if defined(__STDC__) || defined(VMS) 240 #define CNF_CONST const 241 #else 242 #define CNF_CONST 243 #endif 244 245 /* ----- Macros common to calling C from FORTRAN and FORTRAN from C ---- */ 246 247 248 /* --- External Names --- */ 249 250 /* Macro to define the name of a Fortran routine or common block. This */ 251 /* ends in an underscore on many Unix systems. */ 252 253 #define F77_EXTERNAL_NAME(X) X ## _ 254 255 256 /* --- Logical Values --- */ 257 258 /* Define the values that are used to represent the logical values TRUE */ 259 /* and FALSE in Fortran. */ 260 261 #define F77_TRUE 1 262 #define F77_FALSE 0 263 264 /* Define macros that evaluate to C logical values, given a FORTRAN */ 265 /* logical value. */ 266 267 #define F77_ISTRUE(X) ( X ) 268 #define F77_ISFALSE(X) ( !( X ) ) 269 270 271 /* --- Common Blocks --- */ 272 273 /* Macros used in referring to FORTRAN common blocks. */ 274 275 #define F77_BLANK_COMMON @BLANK_COMMON_SYMBOL@ 276 #define F77_NAMED_COMMON(B) F77_EXTERNAL_NAME(B) 277 278 279 280 /* ------------------ Calling C from FORTRAN --------------------------- */ 281 282 283 /* --- Data Types --- */ 284 285 /* Define macros for all the Fortran data types (except COMPLEX, which is */ 286 /* not handled by this package). */ 287 288 #define F77_INTEGER_TYPE int 289 #define F77_REAL_TYPE float 290 #define F77_REAL_FUNCTION_TYPE float 291 #define F77_DOUBLE_TYPE double 292 #define F77_LOGICAL_TYPE int 293 #define F77_CHARACTER_TYPE char 294 #define F77_BYTE_TYPE signed char 295 #define F77_WORD_TYPE short int 296 #define F77_UBYTE_TYPE unsigned char 297 #define F77_UWORD_TYPE unsigned short int 298 299 /* Define macros for the type of a CHARACTER and CHARACTER_ARRAY argument */ 300 #define F77_CHARACTER_ARG_TYPE char 301 #define F77_CHARACTER_ARRAY_ARG_TYPE char 302 303 /* Define a macro to use when passing arguments that STARLINK FORTRAN */ 304 /* treats as a pointer. From the point of view of C, this type should be */ 305 /* (void *), but it is declared as type unsigned int as we actually pass */ 306 /* an INTEGER from the FORTRAN routine. The distinction is important for */ 307 /* architectures where the size of an INTEGER is not the same as the size */ 308 /* of a pointer. */ 309 310 #define F77_POINTER_TYPE unsigned int 311 312 313 /* --- Subroutine Names --- */ 314 315 /* This declares that the C function returns a value of void. */ 316 317 #define F77_SUBROUTINE(X) void F77_EXTERNAL_NAME(X) 318 319 320 /* --- Function Names --- */ 321 322 /* Macros to define the types and names of functions that return values. */ 323 /* Due the the different ways that function return values could be */ 324 /* implemented, it is better not to use functions, but to stick to using */ 325 /* subroutines. */ 326 327 /* Character functions are implemented, but in a way that cannot be */ 328 /* guaranteed to be portable although it will work on VMS, SunOS, Ultrix */ 329 /* and DEC OSF/1. It would be better to return the character value as a */ 330 /* subroutine argument where possible, rather than use a character */ 331 /* function. */ 332 333 #define F77_INTEGER_FUNCTION(X) F77_INTEGER_TYPE F77_EXTERNAL_NAME(X) 334 #define F77_REAL_FUNCTION(X) F77_REAL_FUNCTION_TYPE F77_EXTERNAL_NAME(X) 335 #define F77_DOUBLE_FUNCTION(X) F77_DOUBLE_TYPE F77_EXTERNAL_NAME(X) 336 #define F77_LOGICAL_FUNCTION(X) F77_LOGICAL_TYPE F77_EXTERNAL_NAME(X) 337 #define F77_CHARACTER_FUNCTION(X) void F77_EXTERNAL_NAME(X) 338 #define F77_BYTE_FUNCTION(X) F77_BYTE_TYPE F77_EXTERNAL_NAME(X) 339 #define F77_WORD_FUNCTION(X) F77_WORD_TYPE F77_EXTERNAL_NAME(X) 340 #define F77_UBYTE_FUNCTION(X) F77_UBYTE_TYPE F77_EXTERNAL_NAME(X) 341 #define F77_UWORD_FUNCTION(X) F77_UWORD_TYPE F77_EXTERNAL_NAME(X) 342 #define F77_POINTER_FUNCTION(X) F77_POINTER_TYPE F77_EXTERNAL_NAME(X) 343 344 345 /* --- Character return value for a function --- */ 346 347 #define CHARACTER_RETURN_VALUE(X) CHARACTER(X) TRAIL(X) 348 #define CHARACTER_RETURN_ARG(X) CHARACTER_ARG(X) TRAIL_ARG(X) 349 350 /* --- Dummy Arguments --- */ 351 352 /* Macros for defining subroutine arguments. All these macros take a */ 353 /* single argument; the name of the parameter. On most systems, a numeric */ 354 /* argument is passed as a pointer. */ 355 356 #define INTEGER(X) F77_INTEGER_TYPE *CNF_CONST X 357 #define REAL(X) F77_REAL_TYPE *CNF_CONST X 358 #define DOUBLE(X) F77_DOUBLE_TYPE *CNF_CONST X 359 #define LOGICAL(X) F77_LOGICAL_TYPE *CNF_CONST X 360 #define BYTE(X) F77_BYTE_TYPE *CNF_CONST X 361 #define WORD(X) F77_WORD_TYPE *CNF_CONST X 362 #define UBYTE(X) F77_UBYTE_TYPE *CNF_CONST X 363 #define UWORD(X) F77_UWORD_TYPE *CNF_CONST X 364 365 /* Pointer arguments. Define a pointer type for passing pointer values */ 366 /* between subroutines. */ 367 368 #define POINTER(X) F77_POINTER_TYPE *CNF_CONST X 369 370 /* EXTERNAL arguments. Define a passed subroutine or function name */ 371 #define SUBROUTINE(X) void (*X)() 372 #define INTEGER_FUNCTION(X) F77_INTEGER_TYPE (*X)() 373 #define REAL_FUNCTION(X) F77_REAL_TYPE (*X)() 374 #define DOUBLE_FUNCTION(X) F77_DOUBLE_TYPE (*X)() 375 #define LOGICAL_FUNCTION(X) F77_LOGICAL_TYPE (*X)() 376 #define CHARACTER_FUNCTION(X) F77_CHARACTER_TYPE (*X)() 377 #define BYTE_FUNCTION(X) F77_BYTE_TYPE (*X)() 378 #define WORD_FUNCTION(X) F77_WORD_TYPE (*X)() 379 #define UBYTE_FUNCTION(X) F77_UBYTE_TYPE (*X)() 380 #define UWORD_FUNCTION(X) F77_UWORD_TYPE (*X)() 381 #define POINTER_FUNCTION(X) F77_POINTER_TYPE (*X)() 382 383 /* Array arguments. */ 384 385 #define INTEGER_ARRAY(X) F77_INTEGER_TYPE *CNF_CONST X 386 #define REAL_ARRAY(X) F77_REAL_TYPE *CNF_CONST X 387 #define DOUBLE_ARRAY(X) F77_DOUBLE_TYPE *CNF_CONST X 388 #define LOGICAL_ARRAY(X) F77_LOGICAL_TYPE *CNF_CONST X 389 #define BYTE_ARRAY(X) F77_BYTE_TYPE *CNF_CONST X 390 #define WORD_ARRAY(X) F77_WORD_TYPE *CNF_CONST X 391 #define UBYTE_ARRAY(X) F77_UBYTE_TYPE *CNF_CONST X 392 #define UWORD_ARRAY(X) F77_UWORD_TYPE *CNF_CONST X 393 394 #define POINTER_ARRAY(X) F77_POINTER_TYPE *CNF_CONST X 395 396 /* Macros to handle character arguments. */ 397 398 /* Character arguments can be passed in many ways. The purpose of these */ 399 /* macros and the GENPTR_CHARACTER macro (defined in the next section) is */ 400 /* to generate a pointer to a character variable called ARG and an integer */ 401 /* ARG_length containing the length of ARG. If these two variables are */ 402 /* available directly from the argument list of the routine, then the */ 403 /* GENPTR_CHARACTER macro is null, otherwise it works on intermediate */ 404 /* variables. */ 405 406 #define CHARACTER(X) F77_CHARACTER_TYPE *CNF_CONST X 407 #define TRAIL(X) ,int X ## _length 408 #define CHARACTER_ARRAY(X) F77_CHARACTER_TYPE *CNF_CONST X 409 410 411 /* --- Getting Pointers to Arguments --- */ 412 413 /* Macros that ensure that a pointer to each argument is available for the */ 414 /* programmer to use. Usually this means that these macros are null. On */ 415 /* VMS, a pointer to a character variable has to be generated. If a */ 416 /* particular machine were to pass arguments by reference, rather than by */ 417 /* value, then these macros would construct the appropriate pointers. */ 418 419 #define GENPTR_INTEGER(X) 420 #define GENPTR_REAL(X) 421 #define GENPTR_DOUBLE(X) 422 #define GENPTR_CHARACTER(X) 423 #define GENPTR_LOGICAL(X) 424 #define GENPTR_BYTE(X) 425 #define GENPTR_WORD(X) 426 #define GENPTR_UBYTE(X) 427 #define GENPTR_UWORD(X) 428 #define GENPTR_POINTER(X) 429 430 #define GENPTR_INTEGER_ARRAY(X) 431 #define GENPTR_REAL_ARRAY(X) 432 #define GENPTR_DOUBLE_ARRAY(X) 433 #define GENPTR_CHARACTER_ARRAY(X) 434 #define GENPTR_LOGICAL_ARRAY(X) 435 #define GENPTR_BYTE_ARRAY(X) 436 #define GENPTR_WORD_ARRAY(X) 437 #define GENPTR_UBYTE_ARRAY(X) 438 #define GENPTR_UWORD_ARRAY(X) 439 #define GENPTR_POINTER_ARRAY(X) 440 441 #define GENPTR_SUBROUTINE(X) 442 #define GENPTR_INTEGER_FUNCTION(X) 443 #define GENPTR_REAL_FUNCTION(X) 444 #define GENPTR_DOUBLE_FUNCTION(X) 445 #define GENPTR_CHARACTER_FUNCTION(X) 446 #define GENPTR_LOGICAL_FUNCTION(X) 447 #define GENPTR_BYTE_FUNCTION(X) 448 #define GENPTR_WORD_FUNCTION(X) 449 #define GENPTR_UBYTE_FUNCTION(X) 450 #define GENPTR_UWORD_FUNCTION(X) 451 #define GENPTR_POINTER_FUNCTION(X) 452 453 454 455 /* ------------------ Calling FORTRAN from C --------------------------- */ 456 457 458 /* --- Declare variables --- */ 459 460 #define DECLARE_INTEGER(X) F77_INTEGER_TYPE X 461 #define DECLARE_REAL(X) F77_REAL_TYPE X 462 #define DECLARE_DOUBLE(X) F77_DOUBLE_TYPE X 463 #define DECLARE_LOGICAL(X) F77_LOGICAL_TYPE X 464 #define DECLARE_BYTE(X) F77_BYTE_TYPE X 465 #define DECLARE_WORD(X) F77_WORD_TYPE X 466 #define DECLARE_UBYTE(X) F77_UBYTE_TYPE X 467 #define DECLARE_UWORD(X) F77_UWORD_TYPE X 468 469 #define DECLARE_POINTER(X) F77_POINTER_TYPE X 470 471 #define DECLARE_CHARACTER(X,L) F77_CHARACTER_TYPE X[L]; \ 472 const int X##_length = L 473 474 475 /* --- Declare arrays --- */ 476 477 #define DECLARE_INTEGER_ARRAY(X,D) F77_INTEGER_TYPE X[D] 478 #define DECLARE_REAL_ARRAY(X,D) F77_REAL_TYPE X[D] 479 #define DECLARE_DOUBLE_ARRAY(X,D) F77_DOUBLE_TYPE X[D] 480 #define DECLARE_LOGICAL_ARRAY(X,D) F77_LOGICAL_TYPE X[D] 481 #define DECLARE_BYTE_ARRAY(X,D) F77_BYTE_TYPE X[D] 482 #define DECLARE_WORD_ARRAY(X,D) F77_WORD_TYPE X[D] 483 #define DECLARE_UBYTE_ARRAY(X,D) F77_UBYTE_TYPE X[D] 484 #define DECLARE_UWORD_ARRAY(X,D) F77_UWORD_TYPE X[D] 485 #define DECLARE_POINTER_ARRAY(X,D) F77_POINTER_TYPE X[D] 486 #define DECLARE_CHARACTER_ARRAY(X,L,D) F77_CHARACTER_TYPE X[D][L]; \ 487 const int X##_length = L 488 489 /* --- Declare and construct dynamic CHARACTER arguments --- */ 490 #define DECLARE_CHARACTER_DYN(X) F77_CHARACTER_TYPE *X = NULL;\ 491 int X##_length = 0 492 #define F77_CREATE_CHARACTER(X,L) X=cnfCref(L);\ 493 X##_length = (L>0?L:1) 494 495 /* Declare Dynamic Fortran arrays */ 496 #define DECLARE_INTEGER_ARRAY_DYN(X) F77_INTEGER_TYPE *X = NULL 497 #define DECLARE_REAL_ARRAY_DYN(X) F77_REAL_TYPE *X = NULL 498 #define DECLARE_DOUBLE_ARRAY_DYN(X) F77_DOUBLE_TYPE *X = NULL 499 #define DECLARE_LOGICAL_ARRAY_DYN(X) F77_LOGICAL_TYPE *X = NULL 500 #define DECLARE_BYTE_ARRAY_DYN(X) F77_BYTE_TYPE *X = NULL 501 #define DECLARE_WORD_ARRAY_DYN(X) F77_WORD_TYPE *X = NULL 502 #define DECLARE_UBYTE_ARRAY_DYN(X) F77_UBYTE_TYPE *X = NULL 503 #define DECLARE_UWORD_ARRAY_DYN(X) F77_UWORD_TYPE *X = NULL 504 #define DECLARE_POINTER_ARRAY_DYN(X) F77_POINTER_TYPE *X = NULL 505 #define DECLARE_CHARACTER_ARRAY_DYN(X) F77_CHARACTER_TYPE *X = NULL;\ 506 int X##_length = 0 507 508 /* Create arrays dynamic Fortran arrays for those types which require */ 509 /* Separate space for Fortran and C arrays */ 510 /* Character and logical are already defined */ 511 /* For most types there is nothing to do */ 512 #define F77_CREATE_CHARACTER_ARRAY(X,L,N) \ 513 {int f77dims[1];f77dims[0]=N;X=cnfCrefa(L,1,f77dims);X##_length=L;} 514 #define F77_CREATE_CHARACTER_ARRAY_M(X,L,N,D) X=cnfCrefa(L,N,D);\ 515 X##_length = L 516 #define F77_CREATE_LOGICAL_ARRAY(X,N) \ 517 {int f77dims[1];f77dims[0]=N;X=cnfCrela(1,f77dims);} 518 #define F77_CREATE_LOGICAL_ARRAY_M(X,N,D) X=cnfCrela(N,D) 519 #define F77_CREATE_INTEGER_ARRAY(X,N) 520 #define F77_CREATE_REAL_ARRAY(X,N) 521 #define F77_CREATE_DOUBLE_ARRAY(X,N) 522 #define F77_CREATE_BYTE_ARRAY(X,N) 523 #define F77_CREATE_UBYTE_ARRAY(X,N) 524 #define F77_CREATE_WORD_ARRAY(X,N) 525 #define F77_CREATE_UWORD_ARRAY(X,N) 526 #define F77_CREATE_POINTER_ARRAY(X,N)\ 527 X=(F77_POINTER_TYPE *) malloc(N*sizeof(F77_POINTER_TYPE)) 528 529 /* Associate Fortran arrays with C arrays */ 530 /* These macros ensure that there is space somewhere for the Fortran */ 531 /* array. They are complemetary to the CREATE_type_ARRAY macros */ 532 #define F77_ASSOC_CHARACTER_ARRAY(F,C) 533 #define F77_ASSOC_LOGICAL_ARRAY(F,C) 534 #define F77_ASSOC_INTEGER_ARRAY(F,C) F=C 535 #define F77_ASSOC_REAL_ARRAY(F,C) F=C 536 #define F77_ASSOC_DOUBLE_ARRAY(F,C) F=C 537 #define F77_ASSOC_BYTE_ARRAY(F,C) F=C 538 #define F77_ASSOC_UBYTE_ARRAY(F,C) F=C 539 #define F77_ASSOC_WORD_ARRAY(F,C) F=C 540 #define F77_ASSOC_UWORD_ARRAY(F,C) F=C 541 #define F77_ASSOC_POINTER_ARRAY(F,C) 542 543 /* Free created dynamic arrays */ 544 /* Character and logical are already defined */ 545 /* For most types there is nothing to do */ 546 #define F77_FREE_INTEGER(X) 547 #define F77_FREE_REAL(X) 548 #define F77_FREE_DOUBLE(X) 549 #define F77_FREE_BYTE(X) 550 #define F77_FREE_UBYTE(X) 551 #define F77_FREE_WORD(X) 552 #define F77_FREE_UWORD(X) 553 #define F77_FREE_POINTER(X) cnfFree((void *)X); 554 #define F77_FREE_CHARACTER(X) cnfFreef( X ) 555 #define F77_FREE_LOGICAL(X) cnfFree( (char *)X ) 556 557 /* --- IMPORT and EXPORT of values --- */ 558 /* Export C variables to Fortran variables */ 559 #define F77_EXPORT_CHARACTER(C,F,L) cnfExprt(C,F,L) 560 #define F77_EXPORT_DOUBLE(C,F) F=C 561 #define F77_EXPORT_INTEGER(C,F) F=C 562 #define F77_EXPORT_LOGICAL(C,F) F=C?F77_TRUE:F77_FALSE 563 #define F77_EXPORT_REAL(C,F) F=C 564 #define F77_EXPORT_BYTE(C,F) F=C 565 #define F77_EXPORT_WORD(C,F) F=C 566 #define F77_EXPORT_UBYTE(C,F) F=C 567 #define F77_EXPORT_UWORD(C,F) F=C 568 #define F77_EXPORT_POINTER(C,F) F=cnfFptr(C) 569 #define F77_EXPORT_LOCATOR(C,F) cnfExpch(C,F,DAT__SZLOC) 570 571 /* Allow for character strings to be NULL, protects strlen. Note this 572 * does not allow lengths to differ. */ 573 #define F77_CREATE_EXPORT_CHARACTER(C,F) \ 574 if (C) { \ 575 F77_CREATE_CHARACTER(F,strlen(C)); \ 576 F77_EXPORT_CHARACTER(C,F,F##_length); \ 577 } else { \ 578 F77_CREATE_CHARACTER(F,1); \ 579 F77_EXPORT_CHARACTER(" ",F,F##_length); \ 580 } 581 582 /* Export C arrays to Fortran */ 583 /* Arrays are assumed to be 1-d so just the number of elements is given */ 584 /* This may be OK for n-d arrays also */ 585 /* CHARACTER arrays may be represented in C as arrays of arrays of char or */ 586 /* as arrays of pointers to char (the _P variant) */ 587 #define F77_EXPORT_CHARACTER_ARRAY(C,LC,F,LF,N) \ 588 {int f77dims[1];f77dims[0]=N;cnfExprta(C,LC,F,LF,1,f77dims);} 589 #define F77_EXPORT_CHARACTER_ARRAY_P(C,F,LF,N) \ 590 {int f77dims[1];f77dims[0]=N;cnfExprtap(C,F,LF,1,f77dims);} 591 #define F77_EXPORT_DOUBLE_ARRAY(C,F,N) F=(F77_DOUBLE_TYPE *)C 592 #define F77_EXPORT_INTEGER_ARRAY(C,F,N) F=(F77_INTEGER_TYPE *)C 593 #define F77_EXPORT_LOGICAL_ARRAY(C,F,N) \ 594 {int f77dims[1];f77dims[0]=N;cnfExpla(C,F,1,f77dims);} 595 #define F77_EXPORT_REAL_ARRAY(C,F,N) F=(F77_REAL_TYPE *)C 596 #define F77_EXPORT_BYTE_ARRAY(C,F,N) F=(F77_BYTE_TYPE *)C 597 #define F77_EXPORT_WORD_ARRAY(C,F,N) F=(F77_WORD_TYPE *)C 598 #define F77_EXPORT_UBYTE_ARRAY(C,F,N) F=(F77_UBYTE_TYPE *)C 599 #define F77_EXPORT_UWORD_ARRAY(C,F,N) F=(F77_UWORD_TYPE * )C 600 #define F77_EXPORT_POINTER_ARRAY(C,F,N) \ 601 {int f77i;for (f77i=0;f77i<N;f77i++)F[f77i]=cnfFptr(C[f77i]);} 602 #define F77_EXPORT_LOCATOR_ARRAY(C,F,N) \ 603 {int f77i;for (f77i=0;f77i<N;f77i++)cnfExpch(C,F,DAT__SZLOC);} 604 605 /* Import Fortran variables to C */ 606 #define F77_IMPORT_CHARACTER(F,L,C) cnfImprt(F,L,C) 607 #define F77_IMPORT_DOUBLE(F,C) C=F 608 #define F77_IMPORT_INTEGER(F,C) C=F 609 #define F77_IMPORT_LOGICAL(F,C) C=F77_ISTRUE(F) 610 #define F77_IMPORT_REAL(F,C) C=F 611 #define F77_IMPORT_BYTE(F,C) C=F 612 #define F77_IMPORT_WORD(F,C) C=F 613 #define F77_IMPORT_UBYTE(F,C) C=F 614 #define F77_IMPORT_UWORD(F,C) C=F 615 #define F77_IMPORT_POINTER(F,C) C=cnfCptr(F) 616 #define F77_IMPORT_LOCATOR(F,C) cnfImpch(F,DAT__SZLOC,C) 617 618 /* Import Fortran arrays to C */ 619 /* Arrays are assumed to be 1-d so just the number of elements is given */ 620 /* This may be OK for n-d arrays also */ 621 /* CHARACTER arrays may be represented in C as arrays of arrays of char or */ 622 /* as arrays of pointers to char (the _P variant) */ 623 #define F77_IMPORT_CHARACTER_ARRAY(F,LF,C,LC,N) \ 624 {int f77dims[1];f77dims[0]=N;cnfImprta(F,LF,C,LC,1,f77dims);} 625 #define F77_IMPORT_CHARACTER_ARRAY_P(F,LF,C,LC,N) \ 626 {int f77dims[1];f77dims[0]=N;cnfImprtap(F,LF,C,LC,1,f77dims);} 627 #define F77_IMPORT_DOUBLE_ARRAY(F,C,N) 628 #define F77_IMPORT_INTEGER_ARRAY(F,C,N) 629 #define F77_IMPORT_LOGICAL_ARRAY(F,C,N) \ 630 {int f77dims[1];f77dims[0]=N;cnfImpla(F,C,1,f77dims);} 631 #define F77_IMPORT_REAL_ARRAY(F,C,N) 632 #define F77_IMPORT_BYTE_ARRAY(F,C,N) 633 #define F77_IMPORT_WORD_ARRAY(F,C,N) 634 #define F77_IMPORT_UBYTE_ARRAY(F,C,N) 635 #define F77_IMPORT_UWORD_ARRAY(F,C,N) 636 #define F77_IMPORT_POINTER_ARRAY(F,C,N) \ 637 {int f77i;for (f77i=0;f77i<N;f77i++)C[f77i]=cnfCptr(F[f77i]);} 638 #define F77_IMPORT_LOCATOR_ARRAY(F,C,N) \ 639 {int f77i;for (f77i=0;f77i<N;f77i++)cnfImpch(F,DAT__SZLOC,C);} 640 641 /* --- Call a FORTRAN routine --- */ 642 643 #define F77_CALL(X) F77_EXTERNAL_NAME(X) 644 645 646 /* --- Execute code synchronised by the CNF global mutex */ 647 #define F77_LOCK(code) \ 648 cnfLock(); \ 649 code \ 650 cnfUnlock(); 651 652 /* --- Pass arguments to a FORTRAN routine --- */ 653 654 #define INTEGER_ARG(X) X 655 #define REAL_ARG(X) X 656 #define DOUBLE_ARG(X) X 657 #define LOGICAL_ARG(X) X 658 #define BYTE_ARG(X) X 659 #define WORD_ARG(X) X 660 #define UBYTE_ARG(X) X 661 #define UWORD_ARG(X) X 662 #define POINTER_ARG(X) X 663 #define CHARACTER_ARG(X) X 664 #define TRAIL_ARG(X) ,X##_length 665 666 #define SUBROUTINE_ARG(X) X 667 #define INTEGER_FUNCTION_ARG(X) X 668 #define REAL_FUNCTION_ARG(X) X 669 #define DOUBLE_FUNCTION_ARG(X) X 670 #define LOGICAL_FUNCTION_ARG(X) X 671 #define CHARACTER_FUNCTION_ARG(X) X 672 #define BYTE_FUNCTION_ARG(X) X 673 #define WORD_FUNCTION_ARG(X) X 674 #define UBYTE_FUNCTION_ARG(X) X 675 #define UWORD_FUNCTION_ARG(X) X 676 #define POINTER_FUNCTION_ARG(X) X 677 678 #define INTEGER_ARRAY_ARG(X) (F77_INTEGER_TYPE *)X 679 #define REAL_ARRAY_ARG(X) (F77_REAL_TYPE *)X 680 #define DOUBLE_ARRAY_ARG(X) (F77_DOUBLE_TYPE *)X 681 #define LOGICAL_ARRAY_ARG(X) (F77_LOGICAL_TYPE *)X 682 #define BYTE_ARRAY_ARG(X) (F77_BYTE_TYPE *)X 683 #define WORD_ARRAY_ARG(X) (F77_WORD_TYPE *)X 684 #define UBYTE_ARRAY_ARG(X) (F77_UBYTE_TYPE *)X 685 #define UWORD_ARRAY_ARG(X) (F77_UWORD_TYPE *)X 686 #define POINTER_ARRAY_ARG(X) (F77_POINTER_TYPE *)X 687 #define CHARACTER_ARRAY_ARG(X) (F77_CHARACTER_ARRAY_ARG_TYPE *)X 688 689 /* Put the 64-bit INT support in one place */ 690 #define F77_INTEGER8_TYPE int64_t 691 #define F77_INTEGER8_FUNCTION(X) F77_INTEGER8_TYPE F77_EXTERNAL_NAME(X) 692 #define INTEGER8(X) F77_INTEGER8_TYPE *CNF_CONST X 693 #define INTEGER8_FUNCTION(X) F77_INTEGER8_TYPE (*X)() 694 #define INTEGER8_ARRAY(X) F77_INTEGER8_TYPE *CNF_CONST X 695 #define GENPTR_INTEGER8(X) 696 #define GENPTR_INTEGER8_ARRAY(X) 697 #define GENPTR_INTEGER8_FUNCTION(X) 698 #define DECLARE_INTEGER8(X) F77_INTEGER8_TYPE X 699 #define DECLARE_INTEGER8_ARRAY(X,D) F77_INTEGER8_TYPE X[D] 700 #define DECLARE_INTEGER8_ARRAY_DYN(X) F77_INTEGER8_TYPE *X = NULL 701 #define F77_CREATE_INTEGER8_ARRAY(X,N) 702 #define F77_ASSOC_INTEGER8_ARRAY(F,C) F=C 703 #define F77_FREE_INTEGER8(X) 704 #define F77_EXPORT_INTEGER8(C,F) F=C 705 #define F77_EXPORT_INTEGER8_ARRAY(C,F,N) F=(F77_INTEGER8_TYPE *)C 706 #define F77_IMPORT_INTEGER8(F,C) C=F 707 #define F77_IMPORT_INTEGER8_ARRAY(F,C,N) 708 #define INTEGER8_ARG(X) X 709 #define INTEGER8_FUNCTION_ARG(X) X 710 #define INTEGER8_ARRAY_ARG(X) (F77_INTEGER8_TYPE *)X 711 712 /* ------------------------ Non-ansi section ------------------------------ */ 713 714 /* The difference between ANSI and non-ANSI compilers, as far as macro */ 715 /* definition is concerned, is that non-ANSI compilers do not support the */ 716 /* token concatenation operator (##). To work around this, we use the fact */ 717 /* that the null comment is preprocessed to produce no characters at all */ 718 /* by our non-ANSI compilers. */ 719 /* This section does not deal with the fact that some non-ANSI compilers */ 720 /* cannot handle function prototypes. That is handled in the machine */ 721 /* specific sections. */ 722 723 #if !defined(__STDC__) 724 725 /* --- External Name --- */ 726 727 /* Macro to define the name of a Fortran routine or common block. This */ 728 /* ends in an underscore on many Unix systems. */ 729 730 #undef F77_EXTERNAL_NAME 731 #define F77_EXTERNAL_NAME(X) X/**/_ 732 733 734 /* --- Dummy Arguments --- */ 735 736 /* Macros to handle character dummy arguments. */ 737 738 #undef TRAIL 739 #define TRAIL(X) ,int X/**/_length 740 741 742 /* --- Declare variables --- */ 743 744 #undef DECLARE_CHARACTER 745 #define DECLARE_CHARACTER(X,L) F77_CHARACTER_TYPE X[L]; \ 746 const int X/**/_length = L 747 #undef DECLARE_CHARACTER_ARRAY 748 #define DECLARE_CHARACTER_ARRAY(X,L,D) F77_CHARACTER_TYPE X[D][L]; \ 749 const int X/**/_length = L 750 #undef DECLARE_CHARACTER_DYN 751 #define DECLARE_CHARACTER_DYN(X) F77_CHARACTER_TYPE *X;\ 752 int X/**/_length 753 #undef DECLARE_CHARACTER_ARRAY_DYN 754 #define DECLARE_CHARACTER_ARRAY_DYN(X) F77_CHARACTER_TYPE *X;\ 755 int X/**/_length 756 #undef F77_CREATE_CHARACTER 757 #define F77_CREATE_CHARACTER(X,L) X=cnfCref(L);\ 758 X/**/_length = L 759 #undef F77_CREATE_CHARACTER_ARRAY 760 #define F77_CREATE_CHARACTER_ARRAY(X,L,N) \ 761 {int f77dims[1];f77dims[0]=N;X=cnfCrefa(L,1,f77dims);X/**/_length=L;} 762 763 /* --- Pass arguments to a FORTRAN routine --- */ 764 765 #undef TRAIL_ARG 766 #define TRAIL_ARG(X) ,X/**/_length 767 768 769 #endif /* of non ANSI redefinitions */ 770 771 772 /* ----------------------------------------------------------------------- */ 773 774 /* The standard macros defined above are known to work with the following */ 775 /* systems: */ 776 777 /*-------- 778 | Sun | 779 ---------*/ 780 781 /* On SunOS, the ANSI definitions work with the acc and gcc compilers. */ 782 /* The cc compiler uses the non ANSI definitions. It also needs the K&R */ 783 /* definitions in the file kr.h. */ 784 /* On Solaris, the standard definitions work with the cc compiler. */ 785 786 #if defined(sun) 787 788 #if !defined(__STDC__) 789 #if !defined(_F77_KR) 790 #define _F77_KR 791 #endif 792 #endif 793 794 #endif /* Sun */ 795 796 /* -------------------- System dependent sections ------------------------- */ 797 798 /*------------ 799 | VAX/VMS | 800 -------------*/ 801 802 /* Many macros need to be changed due to the way that VMS handles external */ 803 /* names, passes character arguments and handles logical values. */ 804 805 806 #if defined(VMS) 807 808 /* --- Data Types --- */ 809 810 /* Redefine the macro for the byte data type as signed is not valid syntax */ 811 /* as the VMS compiler is not ANSI compliant. */ 812 813 #undef F77_BYTE_TYPE 814 #define F77_BYTE_TYPE char 815 816 817 /* --- External Names --- */ 818 819 /* Macro to define the name of a Fortran routine or common block. */ 820 /* Fortran and C routines names are the same on VMS. */ 821 822 #undef F77_EXTERNAL_NAME 823 #define F77_EXTERNAL_NAME(X) X 824 825 826 /* --- Dummy Arguments --- */ 827 828 /* Macros to handle character arguments. */ 829 /* Character string arguments are pointers to character string descriptors */ 830 /* and there are no trailing arguments. */ 831 832 #if( VMS != 0 ) 833 #include <descrip.h> 834 #endif 835 836 837 #undef F77_CHARACTER_ARG_TYPE 838 #define F77_CHARACTER_ARG_TYPE struct dsc$descriptor_s 839 #undef F77_CHARACTER_ARRAY_ARG_TYPE 840 #define F77_CHARACTER_ARRAY_ARG_TYPE struct dsc$descriptor_a 841 #undef CHARACTER 842 #define CHARACTER(X) F77_CHARACTER_ARG_TYPE *CNF_CONST X/**/_arg 843 #undef TRAIL 844 #define TRAIL(X) 845 #undef CHARACTER_ARRAY 846 #define CHARACTER_ARRAY(X) F77_CHARACTER_ARRAY_ARG_TYPE *CNF_CONST X/**/_arg 847 #undef GENPTR_CHARACTER 848 #define GENPTR_CHARACTER(X) \ 849 F77_CHARACTER_TYPE *X = X/**/_arg->dsc$a_pointer; \ 850 int X/**/_length = X/**/_arg->dsc$w_length; 851 #undef GENPTR_CHARACTER_ARRAY 852 #define GENPTR_CHARACTER_ARRAY(X) GENPTR_CHARACTER(X) 853 854 855 /* --- Logical Values --- */ 856 857 #undef F77_TRUE 858 #define F77_TRUE -1 859 #undef F77_ISTRUE 860 #define F77_ISTRUE(X) ( (X)&1 ) 861 #undef F77_ISFALSE 862 #define F77_ISFALSE(X) ( ! ( (X)&1 ) ) 863 864 865 /* --- Common Blocks --- */ 866 867 #undef F77_BLANK_COMMON 868 #define F77_BLANK_COMMON $BLANK 869 870 871 /* --- Declare Variables --- */ 872 873 #undef DECLARE_CHARACTER 874 #define DECLARE_CHARACTER(X,L) \ 875 F77_CHARACTER_TYPE X[L]; const int X/**/_length = L; \ 876 F77_CHARACTER_ARG_TYPE X/**/_descr = \ 877 { L, DSC$K_DTYPE_T, DSC$K_CLASS_S, X }; \ 878 F77_CHARACTER_ARG_TYPE *X/**/_arg = &X/**/_descr 879 #undef DECLARE_CHARACTER_ARRAY 880 #define DECLARE_CHARACTER_ARRAY(X,L,D) \ 881 F77_CHARACTER_TYPE X[D][L]; const int X/**/_length = L; \ 882 F77_CHARACTER_ARRAY_ARG_TYPE X/**/_descr = \ 883 { L, DSC$K_DTYPE_T, DSC$K_CLASS_S, X }; \ 884 F77_CHARACTER_ARRAY_ARG_TYPE *X/**/_arg = &X/**/_descr 885 886 887 /* --- The dynamic allocation of character arguments --- */ 888 #undef DECLARE_CHARACTER_DYN 889 #define DECLARE_CHARACTER_DYN(X) int X/**/_length;\ 890 F77_CHARACTER_ARG_TYPE *X/**/_arg;\ 891 F77_CHARACTER_TYPE *X 892 #undef DECLARE_CHARACTER_ARRAY_DYN 893 #define DECLARE_CHARACTER_ARRAY_DYN(X) int X/**/_length;\ 894 F77_CHARACTER_ARRAY_ARG_TYPE *X/**/_arg;\ 895 F77_CHARACTER_TYPE *X 896 #undef F77_CREATE_CHARACTER 897 #define F77_CREATE_CHARACTER(X,L) X/**/_arg = cnfCref(L);\ 898 X = X/**/_arg->dsc$a_pointer; \ 899 X/**/_length = X/**/_arg->dsc$w_length 900 #undef F77_CREATE_CHARACTER_ARRAY 901 #define F77_CREATE_CHARACTER_ARRAY(X,L,N) \ 902 {int f77dims[1];f77dims[0]=N;X/**/_arg=cnfCrefa(L,1,f77dims);X/**/_length=L;} 903 #define F77_CREATE_CHARACTER_ARRAY_M(X,L,N,D) X/**/_arg = cnfCrefa(L,N,D);\ 904 X = X/**/_arg->dsc$a_pointer; \ 905 X/**/_length = X/**/_arg->dsc$w_length 906 #undef F77_FREE_CHARACTER 907 #define F77_FREE_CHARACTER(X) cnfFreef( X/**/_arg ) 908 909 /* --- Pass arguments to a FORTRAN routine --- */ 910 911 #undef CHARACTER_ARG 912 #define CHARACTER_ARG(X) X/**/_arg 913 #undef CHARACTER_ARRAY_ARG 914 #define CHARACTER_ARRAY_ARG(X) X/**/_arg 915 #undef TRAIL_ARG 916 #define TRAIL_ARG(X) 917 918 #endif /* VMS */ 919 920 /* ----------------------------------------------------------------------- */ 921 922 /*-------------------------- 923 | DECstation Ultrix (cc) | 924 | DECstation Ultrix (c89) | 925 | DECstation OSF/1 | 926 | Alpha OSF/1 | 927 --------------------------*/ 928 929 /* Do this complicated set of definitions as a single #if cannot be */ 930 /* continued across multiple lines. */ 931 932 #if defined(mips) && defined(ultrix) 933 #define _dec_unix 1 934 #endif 935 #if defined(__mips) && defined(__ultrix) 936 #define _dec_unix 1 937 #endif 938 #if defined(__mips__) && defined(__osf__) 939 #define _dec_unix 1 940 #endif 941 #if defined(__alpha) && defined(__osf__) 942 #define _dec_unix 1 943 #endif 944 945 #if _dec_unix 946 947 /* The macros for Ultrix are the same as the standard ones except for ones */ 948 /* dealing with logical values. The ANSI definitions work with the c89 */ 949 /* compiler, and the non ANSI definitions work with the cc compiler. */ 950 /* The same applies to DEC OSF/1, except that its cc compiler is ANSI */ 951 /* compliant. */ 952 953 954 /* --- Logical Values --- */ 955 956 /* Redefine macros that evaluate to a C logical value, given a FORTRAN */ 957 /* logical value. These definitions are only valid when used with the DEC */ 958 /* FORTRAN for RISC compiler. If you are using the earlier FORTRAN for */ 959 /* RISC compiler from MIPS, then these macros should be deleted. */ 960 961 #undef F77_TRUE 962 #define F77_TRUE -1 963 #undef F77_ISTRUE 964 #define F77_ISTRUE(X) ( (X)&1 ) 965 #undef F77_ISFALSE 966 #define F77_ISFALSE(X) ( ! ( (X)&1 ) ) 967 968 969 #endif /* DEC Unix */ 970 971 /* 972 *+ 973 * Name: 974 * cnf.h 975 976 * Purpose: 977 * Function prototypes for cnf routines 978 979 * Language: 980 * ANSI C 981 982 * Type of Module: 983 * C include file 984 985 * Description: 986 * These are the prototype definitions for the functions in the CNF 987 * library. They are used used in mixing C and FORTRAN programs. 988 989 * Copyright: 990 * Copyright (C) 1991 Science & Engineering Research Council 991 992 * Authors: 993 * PMA: Peter Allan (Starlink, RAL) 994 * AJC: Alan Chipperfield (Starlink, RAL) 995 * {enter_new_authors_here} 996 997 * History: 998 * 23-MAY-1991 (PMA): 999 * Original version. 1000 * 12-JAN-1996 (AJC): 1001 * Add cnf_cref and cnf_freef 1002 * 14-JUN-1996 (AJC): 1003 * Add cnf_crefa, imprta, exprta 1004 * crela, impla, expla 1005 * 18-JUL-1996 (AJC): 1006 * Add impch and expch 1007 * 17-MAR-1998 (AJC): 1008 * Add imprtap and exprtap 1009 * {enter_changes_here} 1010 1011 * Bugs: 1012 * {note_any_bugs_here} 1013 1014 *- 1015 ------------------------------------------------------------------------------ 1016 */ 1017 void cnfInitRTL( int, char** ); 1018 void *cnfCalloc( size_t, size_t ); 1019 void cnfCopyf( const char *source_f, int source_len, char *dest_f, 1020 int dest_len ); 1021 void *cnfCptr( F77_POINTER_TYPE ); 1022 char *cnfCreat( int length ); 1023 F77_CHARACTER_ARG_TYPE *cnfCref( int length ); 1024 F77_CHARACTER_ARG_TYPE *cnfCrefa( int length, int ndims, const int *dims ); 1025 char *cnfCreib( const char *source_f, int source_len ); 1026 char *cnfCreim( const char *source_f, int source_len ); 1027 F77_LOGICAL_TYPE *cnfCrela( int ndims, const int *dims ); 1028 void cnfExpch( const char *source_c, char *dest_f, int nchars ); 1029 void cnfExpla( const int *source_c, F77_LOGICAL_TYPE *dest_f, int ndims, 1030 const int *dims ); 1031 void cnfExpn( const char *source_c, int max, char *dest_f, int dest_len ); 1032 void cnfExprt( const char *source_c, char *dest_f, int dest_len ); 1033 void cnfExprta( const char *source_c, int source_len, char *dest_f, 1034 int dest_len, int ndims, const int *dims ); 1035 void cnfExprtap( char *const *source_c, char *dest_f, int dest_len, 1036 int ndims, const int *dims ); 1037 F77_POINTER_TYPE cnfFptr( void *cpointer ); 1038 void cnfFree( void * ); 1039 void cnfFreef( F77_CHARACTER_ARG_TYPE *temp ); 1040 void cnfImpb( const char *source_f, int source_len, char *dest_c ); 1041 void cnfImpbn( const char *source_f, int source_len, int max, char *dest_c ); 1042 void cnfImpch( const char *source_f, int nchars, char *dest_c ); 1043 void cnfImpla( const F77_LOGICAL_TYPE *source_f, int *dest_c, 1044 int ndims, const int *dims ); 1045 void cnfImpn( const char *source_f, int source_len, int max, char *dest_c ); 1046 void cnfImprt( const char *source_f, int source_len, char *dest_c ); 1047 void cnfImprta( const char *source_f, int source_len, char *dest_c, 1048 int dest_len, int ndims, const int *dims ); 1049 void cnfImprtap( const char *source_f, int source_len, char *const *dest_c, 1050 int dest_len, int ndims, const int *dims ); 1051 int cnfLenc( const char *source_c ); 1052 int cnfLenf( const char *source_f, int source_len ); 1053 void *cnfMalloc( size_t ); 1054 void *cnfRealloc( void *, size_t ); 1055 int cnfRegp( void * ); 1056 void cnfUregp( void * ); 1057 void cnfLock( void ); 1058 void cnfUnlock( void ); 1059 #endif 1060 1061 #ifndef CNF_OLD_DEFINED 1062 #define CNF_OLD_DEFINED 1063 /* Define old names to be new names */ 1064 #define cnf_calloc cnfCalloc 1065 #define cnf_copyf cnfCopyf 1066 #define cnf_cptr cnfCptr 1067 #define cnf_creat cnfCreat 1068 #define cnf_cref cnfCref 1069 #define cnf_crefa cnfCrefa 1070 #define cnf_creib cnfCreib 1071 #define cnf_creim cnfCreim 1072 #define cnf_crela cnfCrela 1073 #define cnf_expch cnfExpch 1074 #define cnf_expla cnfExpla 1075 #define cnf_expn cnfExpn 1076 #define cnf_exprt cnfExprt 1077 #define cnf_exprta cnfExprta 1078 #define cnf_exprtap cnfExprtap 1079 #define cnf_fptr cnfFptr 1080 #define cnf_free cnfFree 1081 #define cnf_freef cnfFreef 1082 #define cnf_impb cnfImpb 1083 #define cnf_impbn cnfImpbn 1084 #define cnf_impch cnfImpch 1085 #define cnf_impla cnfImpla 1086 #define cnf_impn cnfImpn 1087 #define cnf_imprt cnfImprt 1088 #define cnf_imprta cnfImprta 1089 #define cnf_imprtap cnfImprtap 1090 #define cnf_lenc cnfLenc 1091 #define cnf_lenf cnfLenf 1092 #define cnf_malloc cnfMalloc 1093 #define cnf_regp cnfRegp 1094 #define cnf_uregp cnfUregp 1095 1096 #endif /* CNF_MACROS */ 1097