gcc/f/target.h

   1 /* target.h -- Public #include File (module.h template V1.0)
   2    Copyright (C) 1995, 1996, 2002, 2003
   3    Free Software Foundation, Inc.
   4    Contributed by James Craig Burley.
   5
   6 This file is part of GNU Fortran.
   7
   8 GNU Fortran is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 2, or (at your option)
  11 any later version.
  12
  13 GNU Fortran is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Fortran; see the file COPYING.  If not, write to
  20 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  21 02111-1307, USA.
  22
  23    Owning Modules:
  24       target.c
  25
  26    Modifications:
  27 */
  28
  29 /* Allow multiple inclusion to work. */
  30
  31 #ifndef GCC_F_TARGET_H
  32 #define GCC_F_TARGET_H
  33
  34 #ifndef TREE_CODE
  35 #include "tree.h"
  36 #endif
  37
  38 /* Simple definitions and enumerations. */
  39
  40 #define FFETARGET_charactersizeNONE (-1)
  41 #ifndef FFETARGET_charactersizeMAXIMUM
  42 #define FFETARGET_charactersizeMAXIMUM 2147483647
  43 #endif
  44
  45 #ifndef FFETARGET_defaultIS_90
  46 #define FFETARGET_defaultIS_90 0
  47 #endif
  48 #ifndef FFETARGET_defaultIS_AUTOMATIC
  49 #define FFETARGET_defaultIS_AUTOMATIC 1
  50 #endif
  51 #ifndef FFETARGET_defaultIS_BACKSLASH
  52 #define FFETARGET_defaultIS_BACKSLASH 1
  53 #endif
  54 #ifndef FFETARGET_defaultIS_INIT_LOCAL_ZERO
  55 #define FFETARGET_defaultIS_INIT_LOCAL_ZERO 0
  56 #endif
  57 #ifndef FFETARGET_defaultIS_DOLLAR_OK
  58 #define FFETARGET_defaultIS_DOLLAR_OK 0
  59 #endif
  60 #ifndef FFETARGET_defaultIS_F2C
  61 #define FFETARGET_defaultIS_F2C 1
  62 #endif
  63 #ifndef FFETARGET_defaultIS_F2C_LIBRARY
  64 #define FFETARGET_defaultIS_F2C_LIBRARY 1
  65 #endif
  66 #ifndef FFETARGET_defaultIS_FREE_FORM
  67 #define FFETARGET_defaultIS_FREE_FORM 0
  68 #endif
  69 #ifndef FFETARGET_defaultIS_PEDANTIC
  70 #define FFETARGET_defaultIS_PEDANTIC 0
  71 #endif
  72 #ifndef FFETARGET_defaultCASE_INTRIN
  73 #define FFETARGET_defaultCASE_INTRIN FFE_caseLOWER
  74 #endif
  75 #ifndef FFETARGET_defaultCASE_MATCH
  76 #define FFETARGET_defaultCASE_MATCH FFE_caseLOWER
  77 #endif
  78 #ifndef FFETARGET_defaultCASE_SOURCE
  79 #define FFETARGET_defaultCASE_SOURCE FFE_caseLOWER
  80 #endif
  81 #ifndef FFETARGET_defaultCASE_SYMBOL
  82 #define FFETARGET_defaultCASE_SYMBOL FFE_caseNONE
  83 #endif
  84
  85 #ifndef FFETARGET_defaultFIXED_LINE_LENGTH
  86 #define FFETARGET_defaultFIXED_LINE_LENGTH 72
  87 #endif
  88
  89 /* 1 if external Fortran names ("FOO" in SUBROUTINE FOO, COMMON /FOO/,
  90    and even enforced/default-for-unnamed PROGRAM, blank-COMMON, and
  91    BLOCK DATA names, but not names of library functions implementing
  92    intrinsics or names of local/internal variables) should have an
  93    underscore appended (for compatibility with existing systems).  */
  94
  95 #ifndef FFETARGET_defaultEXTERNAL_UNDERSCORED
  96 #define FFETARGET_defaultEXTERNAL_UNDERSCORED 1
  97 #endif
  98
  99 /* 1 if external Fortran names with underscores already in them should
 100    have an extra underscore appended (in addition to the one they
 101    might already have appened if FFETARGET_defaultEXTERNAL_UNDERSCORED). */
 102
 103 #ifndef FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED
 104 #define FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED 1
 105 #endif
 106
 107 /* If FFETARGET_defaultEXTERNAL_UNDERSCORED is 0, the following definitions
 108    might also need to be overridden to make g77 objects compatible with
 109    f2c+gcc objects.  Although I don't think the unnamed BLOCK DATA one
 110    is an issue at all.  Of course, on some systems it isn't f2c
 111    compatibility that is the issue -- maybe compatibility with some
 112    other compiler(s).  I don't know what to recommend for systems where
 113    there is no existing Fortran compiler -- I suppose porting f2c and
 114    pretending it's the existing one is best for now.  */
 115
 116 /* 1 if the "FOO" in "PROGRAM FOO" should be overridden and a particular
 117    name imposed in place of it in the actual code (normally the case,
 118    because the library's main entry point on most systems calls the main
 119    function by a particular name).  Someday g77 might do the f2c trick
 120    of also outputting a "FOO" procedure that just calls the main procedure,
 121    but that'll wait until somebody shows why it is needed.  */
 122
 123 #ifndef FFETARGET_isENFORCED_MAIN
 124 #define FFETARGET_isENFORCED_MAIN 1
 125 #endif
 126
 127 /* The enforced name of the main program if ENFORCED_MAIN is 1.  */
 128
 129 #ifndef FFETARGET_nameENFORCED_MAIN_NAME
 130 #define FFETARGET_nameENFORCED_MAIN_NAME "MAIN__"
 131 #endif
 132
 133 /* The name used for an unnamed main program if ENFORCED_MAIN is 0.  */
 134
 135 #ifndef FFETARGET_nameUNNAMED_MAIN
 136 #define FFETARGET_nameUNNAMED_MAIN "MAIN__"
 137 #endif
 138
 139 /* The name used for an unnamed block data program.  */
 140
 141 #ifndef FFETARGET_nameUNNAMED_BLOCK_DATA
 142 #define FFETARGET_nameUNNAMED_BLOCK_DATA "_BLOCK_DATA__"
 143 #endif
 144
 145 /* The name used for blank common.  */
 146
 147 #ifndef FFETARGET_nameBLANK_COMMON
 148 #define FFETARGET_nameBLANK_COMMON "_BLNK__"
 149 #endif
 150
 151 #ifndef FFETARGET_integerSMALLEST_POSITIVE
 152 #define FFETARGET_integerSMALLEST_POSITIVE 0
 153 #endif
 154 #ifndef FFETARGET_integerLARGEST_POSITIVE
 155 #define FFETARGET_integerLARGEST_POSITIVE 2147483647
 156 #endif
 157 #ifndef FFETARGET_integerBIG_MAGICAL
 158 #define FFETARGET_integerBIG_MAGICAL 020000000000       /* 2147483648 */
 159 #endif
 160 #ifndef FFETARGET_integerALMOST_BIG_MAGICAL
 161 #define FFETARGET_integerALMOST_BIG_MAGICAL 214748364
 162 #endif
 163 #ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY
 164 #define FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY 0x80000000
 165 #endif
 166 #ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_HEX
 167 #define FFETARGET_integerALMOST_BIG_OVERFLOW_HEX 0x10000000
 168 #endif
 169 #ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL
 170 #define FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL 0x20000000
 171 #endif
 172 #ifndef FFETARGET_integerFINISH_BIG_MAGICAL
 173 #define FFETARGET_integerFINISH_BIG_MAGICAL 8
 174 #endif
 175 #ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY
 176 #define FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY 0
 177 #endif
 178 #ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_HEX
 179 #define FFETARGET_integerFINISH_BIG_OVERFLOW_HEX 0
 180 #endif
 181 #ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL
 182 #define FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL 0
 183 #endif
 184
 185 #ifndef FFETARGET_offsetNONE
 186 #define FFETARGET_offsetNONE 0  /* Not used by FFE, for backend if needed. */
 187 #endif
 188
 189 #define FFETARGET_okINTEGER1 1
 190 #define FFETARGET_okINTEGER2 1
 191 #define FFETARGET_okINTEGER3 1
 192 #define FFETARGET_okINTEGER4 1
 193 #define FFETARGET_okLOGICAL1 1
 194 #define FFETARGET_okLOGICAL2 1
 195 #define FFETARGET_okLOGICAL3 1
 196 #define FFETARGET_okLOGICAL4 1
 197 #define FFETARGET_okREAL1 1
 198 #define FFETARGET_okREAL2 1
 199 #define FFETARGET_okREAL3 0
 200 #define FFETARGET_okREALQUAD FFETARGET_okREAL3
 201 #define FFETARGET_okCOMPLEX1 1
 202 #define FFETARGET_okCOMPLEX2 1
 203 #define FFETARGET_okCOMPLEX3 0
 204 #define FFETARGET_okCOMPLEXDOUBLE FFETARGET_okCOMPLEX2
 205 #define FFETARGET_okCOMPLEXQUAD FFETARGET_okCOMPLEX3
 206 #define FFETARGET_okCHARACTER1 1
 207
 208 #define FFETARGET_f2cTYUNKNOWN 0
 209 #define FFETARGET_f2cTYADDR 1
 210 #define FFETARGET_f2cTYSHORT 2
 211 #define FFETARGET_f2cTYLONG 3
 212 #define FFETARGET_f2cTYREAL 4
 213 #define FFETARGET_f2cTYDREAL 5
 214 #define FFETARGET_f2cTYCOMPLEX 6
 215 #define FFETARGET_f2cTYDCOMPLEX 7
 216 #define FFETARGET_f2cTYLOGICAL 8
 217 #define FFETARGET_f2cTYCHAR 9
 218 #define FFETARGET_f2cTYSUBR 10
 219 #define FFETARGET_f2cTYINT1 11
 220 #define FFETARGET_f2cTYLOGICAL1 12
 221 #define FFETARGET_f2cTYLOGICAL2 13
 222 #define FFETARGET_f2cTYQUAD 14
 223
 224 #if (!defined(__alpha__) \
 225      && (!defined(__hppa__) || !defined(__LP64__)) \
 226      && (!defined(__ia64__) || !defined(__LP64__)) \
 227      && !defined(__MMIX__) \
 228      && (!defined (_ARCH_PPC) || !defined (__64BIT__)) \
 229      && !defined(__powerpc64__) \
 230      && !defined(__s390x__) \
 231      && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__)))\
 232      && !defined(__x86_64__))
 233 #define FFETARGET_32bit_longs
 234 #endif
 235
 236 /* Typedefs. */
 237
 238 typedef unsigned char ffetargetAlign;   /* ffetargetOffset for alignment. */
 239 #define ffetargetAlign_f ""
 240 typedef long ffetargetCharacterSize;
 241 #define ffetargetCharacterSize_f "l"
 242 typedef void (*ffetargetCopyfunc) (void *, void *, size_t);
 243 typedef ffetargetCharacterSize ffetargetHollerithSize;
 244 #define ffetargetHollerithSize_f "l"
 245 typedef long long ffetargetOffset;
 246 #define ffetargetOffset_f "ll"
 247
 248 #if FFETARGET_okINTEGER1
 249 #ifdef FFETARGET_32bit_longs
 250 typedef long int ffetargetInteger1;
 251 #define ffetargetInteger1_f "l"
 252 #else
 253 typedef int ffetargetInteger1;
 254 #define ffetargetInteger1_f ""
 255 #endif
 256 #endif
 257 #if FFETARGET_okINTEGER2
 258 typedef signed char ffetargetInteger2;
 259 #define ffetargetInteger2_f ""
 260 #endif
 261 #if FFETARGET_okINTEGER3
 262 typedef short int ffetargetInteger3;
 263 #define ffetargetInteger3_f ""
 264 #endif
 265 #if FFETARGET_okINTEGER4
 266 typedef long long int ffetargetInteger4;
 267 #define ffetargetInteger4_f "ll"
 268 #endif
 269 #if FFETARGET_okLOGICAL1
 270 #ifdef FFETARGET_32bit_longs
 271 typedef long int ffetargetLogical1;
 272 #define ffetargetLogical1_f "l"
 273 #else
 274 typedef int ffetargetLogical1;
 275 #define ffetargetLogical1_f ""
 276 #endif
 277 #endif
 278 #if FFETARGET_okLOGICAL2
 279 typedef signed char ffetargetLogical2;
 280 #define ffetargetLogical2_f ""
 281 #endif
 282 #if FFETARGET_okLOGICAL3
 283 typedef short int ffetargetLogical3;
 284 #define ffetargetLogical3_f ""
 285 #endif
 286 #if FFETARGET_okLOGICAL4
 287 typedef long long int ffetargetLogical4;
 288 #define ffetargetLogical4_f "ll"
 289 #endif
 290 #if FFETARGET_okREAL1
 291 typedef int ffetargetReal1;
 292 #define ffetargetReal1_f ""
 293 #define ffetarget_cvt_r1_to_rv_(in)                                     \
 294   ({ REAL_VALUE_TYPE _rv;                                               \
 295      long _in = (in);                                                   \
 296      real_from_target (&_rv, &_in, mode_for_size (32, MODE_FLOAT, 0));  \
 297      _rv; })
 298 #define ffetarget_cvt_rv_to_r1_(in, out) \
 299   ({ long _tmp; \
 300      REAL_VALUE_TO_TARGET_SINGLE ((in), _tmp); \
 301      (out) = (ffetargetReal1) _tmp; })
 302 #endif
 303 #if FFETARGET_okREAL2
 304 typedef struct { int v[2]; } ffetargetReal2;
 305 #define ffetargetReal2_f ""
 306 #define ffetarget_cvt_r2_to_rv_(in)                                     \
 307   ({ REAL_VALUE_TYPE _rv; long _tmp[2];                                 \
 308      _tmp[0] = (in)[0]; _tmp[1] = (in)[1];                              \
 309      real_from_target (&_rv, _tmp, mode_for_size (64, MODE_FLOAT, 0));  \
 310      _rv; })
 311 #define ffetarget_cvt_rv_to_r2_(in, out)                                \
 312   ({ long _tmp[2];                                                      \
 313      REAL_VALUE_TO_TARGET_DOUBLE ((in), _tmp);                          \
 314      (out)[0] = (int)_tmp[0]; (out)[1] = (int)_tmp[1]; })
 315 #endif
 316 #if FFETARGET_okREAL3
 317 typedef long ffetargetReal3[?];
 318 ?
 319 #endif
 320 #if FFETARGET_okCOMPLEX1
 321 struct _ffetarget_complex_1_
 322   {
 323     ffetargetReal1 real;
 324     ffetargetReal1 imaginary;
 325   };
 326 typedef struct _ffetarget_complex_1_ ffetargetComplex1;
 327 #endif
 328 #if FFETARGET_okCOMPLEX2
 329 struct _ffetarget_complex_2_
 330   {
 331     ffetargetReal2 real;
 332     ffetargetReal2 imaginary;
 333   };
 334 typedef struct _ffetarget_complex_2_ ffetargetComplex2;
 335 #endif
 336 #if FFETARGET_okCOMPLEX3
 337 struct _ffetarget_complex_3_
 338   {
 339     ffetargetReal3 real;
 340     ffetargetReal3 imaginary;
 341   };
 342 typedef struct _ffetarget_complex_3_ ffetargetComplex3;
 343 #endif
 344 #if FFETARGET_okCHARACTER1
 345 struct _ffetarget_char_1_
 346   {
 347     ffetargetCharacterSize length;
 348     unsigned char *text;
 349   };
 350 typedef struct _ffetarget_char_1_ ffetargetCharacter1;
 351 typedef unsigned char ffetargetCharacterUnit1;
 352 #endif
 353
 354 typedef unsigned long long int ffetargetTypeless;
 355
 356 struct _ffetarget_hollerith_
 357   {
 358     ffetargetHollerithSize length;
 359     unsigned char *text;
 360   };
 361 typedef struct _ffetarget_hollerith_ ffetargetHollerith;
 362
 363 typedef ffetargetCharacter1 ffetargetCharacterDefault;
 364 typedef ffetargetComplex1 ffetargetComplexDefault;
 365 #if FFETARGET_okCOMPLEXDOUBLE
 366 typedef ffetargetComplex2 ffetargetComplexDouble;
 367 #endif
 368 #if FFETARGET_okCOMPLEXQUAD
 369 typedef ffetargetComplex3 ffetargetComplexQuad;
 370 #endif
 371 typedef ffetargetInteger1 ffetargetIntegerDefault;
 372 #define ffetargetIntegerDefault_f ffetargetInteger1_f
 373 typedef ffetargetLogical1 ffetargetLogicalDefault;
 374 #define ffetargetLogicalDefault_f ffetargetLogical1_f
 375 typedef ffetargetReal1 ffetargetRealDefault;
 376 #define ffetargetRealDefault_f ffetargetReal1_f
 377 typedef ffetargetReal2 ffetargetRealDouble;
 378 #define ffetargetRealDouble_f ffetargetReal2_f
 379 #if FFETARGET_okREALQUAD
 380 typedef ffetargetReal3 ffetargetRealQuad;
 381 #define ffetargetRealQuad_f ffetargetReal3_f
 382 #endif
 383
 384 /* Include files needed by this one. */
 385
 386 #include "bad.h"
 387 #include "info.h"
 388 #include "lex.h"
 389 #include "malloc.h"
 390
 391 /* Structure definitions. */
 392
 393
 394 /* Global objects accessed by users of this module. */
 395
 396 extern char ffetarget_string_[40];      /* Temp for ascii-to-double (atof). */
 397 extern HOST_WIDE_INT ffetarget_long_val_;
 398 extern HOST_WIDE_INT ffetarget_long_junk_;
 399
 400 /* Declare functions with prototypes. */
 401
 402 void ffetarget_aggregate_info (ffeinfoBasictype *ebt, ffeinfoKindtype *ekt,
 403                                ffetargetAlign *units, ffeinfoBasictype abt,
 404                                ffeinfoKindtype akt);
 405 ffetargetAlign ffetarget_align (ffetargetAlign *updated_alignment,
 406                                 ffetargetAlign *updated_modulo,
 407                                 ffetargetOffset offset,
 408                                 ffetargetAlign alignment,
 409                                 ffetargetAlign modulo);
 410 #if FFETARGET_okCHARACTER1
 411 bool ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
 412                            mallocPool pool);
 413 int ffetarget_cmp_character1 (ffetargetCharacter1 l, ffetargetCharacter1 r);
 414 ffebad ffetarget_concatenate_character1 (ffetargetCharacter1 *res,
 415                                          ffetargetCharacter1 l,
 416                                          ffetargetCharacter1 r,
 417                                          mallocPool pool,
 418                                          ffetargetCharacterSize *len);
 419 ffebad ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
 420                                             ffetargetCharacterSize res_size,
 421                                                 ffetargetCharacter1 l,
 422                                                 mallocPool pool);
 423 ffebad ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
 424                                             ffetargetCharacterSize res_size,
 425                                                ffetargetHollerith l,
 426                                                mallocPool pool);
 427 ffebad ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res,
 428                                               ffetargetCharacterSize res_size,
 429                                               ffetargetInteger4 l,
 430                                               mallocPool pool);
 431 ffebad ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res,
 432                                               ffetargetCharacterSize res_size,
 433                                               ffetargetLogical4 l,
 434                                               mallocPool pool);
 435 ffebad ffetarget_convert_character1_typeless (ffetargetCharacter1 *res,
 436                                             ffetargetCharacterSize res_size,
 437                                               ffetargetTypeless l,
 438                                               mallocPool pool);
 439 ffebad ffetarget_eq_character1 (bool *res, ffetargetCharacter1 l,
 440                                 ffetargetCharacter1 r);
 441 ffebad ffetarget_le_character1 (bool *res, ffetargetCharacter1 l,
 442                                 ffetargetCharacter1 r);
 443 ffebad ffetarget_ge_character1 (bool *res, ffetargetCharacter1 l,
 444                                 ffetargetCharacter1 r);
 445 ffebad ffetarget_gt_character1 (bool *res, ffetargetCharacter1 l,
 446                                 ffetargetCharacter1 r);
 447 ffebad ffetarget_lt_character1 (bool *res, ffetargetCharacter1 l,
 448                                 ffetargetCharacter1 r);
 449 ffebad ffetarget_ne_character1 (bool *res, ffetargetCharacter1 l,
 450                                 ffetargetCharacter1 r);
 451 ffebad ffetarget_substr_character1 (ffetargetCharacter1 *res,
 452                                     ffetargetCharacter1 l,
 453                                     ffetargetCharacterSize first,
 454                                     ffetargetCharacterSize last,
 455                                     mallocPool pool,
 456                                     ffetargetCharacterSize *len);
 457 #endif
 458 int ffetarget_cmp_hollerith (ffetargetHollerith l, ffetargetHollerith r);
 459 bool ffetarget_hollerith (ffetargetHollerith *val, ffelexToken hollerith,
 460                           mallocPool pool);
 461 int ffetarget_cmp_typeless (ffetargetTypeless l, ffetargetTypeless r);
 462 ffebad ffetarget_convert_any_character1_ (char *res, size_t size,
 463                                           ffetargetCharacter1 l);
 464 ffebad ffetarget_convert_any_hollerith_ (char *res, size_t size,
 465                                          ffetargetHollerith l);
 466 ffebad ffetarget_convert_any_typeless_ (char *res, size_t size,
 467                                         ffetargetTypeless l);
 468 #if FFETARGET_okCOMPLEX1
 469 ffebad ffetarget_divide_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
 470                                   ffetargetComplex1 r);
 471 #endif
 472 #if FFETARGET_okCOMPLEX2
 473 ffebad ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
 474                                   ffetargetComplex2 r);
 475 #endif
 476 #if FFETARGET_okCOMPLEX3
 477 ffebad ffetarget_divide_complex3 (ffetargetComplex3 *res, ffetargetComplex3 l,
 478                                   ffetargetComplex3 r);
 479 #endif
 480 #if FFETARGET_okINTEGER1
 481 bool ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer);
 482 #endif
 483 #if FFETARGET_okINTEGER2
 484 bool ffetarget_integer2 (ffetargetInteger2 *val, ffelexToken integer);
 485 #endif
 486 #if FFETARGET_okINTEGER3
 487 bool ffetarget_integer3 (ffetargetInteger3 *val, ffelexToken integer);
 488 #endif
 489 #if FFETARGET_okINTEGER4
 490 bool ffetarget_integer4 (ffetargetInteger4 *val, ffelexToken integer);
 491 #endif
 492 bool ffetarget_integerbinary (ffetargetIntegerDefault *val,
 493                              ffelexToken integer);
 494 bool ffetarget_integerhex (ffetargetIntegerDefault *val,
 495                              ffelexToken integer);
 496 bool ffetarget_integeroctal (ffetargetIntegerDefault *val,
 497                              ffelexToken integer);
 498 void ffetarget_integer_bad_magical (ffelexToken t);
 499 void ffetarget_integer_bad_magical_binary (ffelexToken integer, ffelexToken minus);
 500 void ffetarget_integer_bad_magical_precedence (ffelexToken integer,
 501                                                ffelexToken uminus,
 502                                                ffelexToken higher_op);
 503 void ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer,
 504                                                       ffelexToken minus,
 505                                                       ffelexToken higher_op);
 506 #if FFETARGET_okCHARACTER1
 507 bool ffetarget_iszero_character1 (ffetargetCharacter1 constant);
 508 #endif
 509 bool ffetarget_iszero_hollerith (ffetargetHollerith constant);
 510 void ffetarget_layout (const char *error_text, ffetargetAlign *alignment,
 511                        ffetargetAlign *modulo, ffetargetOffset *size,
 512                        ffeinfoBasictype bt, ffeinfoKindtype kt,
 513                        ffetargetCharacterSize charsize,
 514                        ffetargetIntegerDefault num_elements);
 515 #if FFETARGET_okCOMPLEX1
 516 ffebad ffetarget_multiply_complex1 (ffetargetComplex1 *res,
 517                                     ffetargetComplex1 l,
 518                                     ffetargetComplex1 r);
 519 #endif
 520 #if FFETARGET_okCOMPLEX2
 521 ffebad ffetarget_multiply_complex2 (ffetargetComplex2 *res,
 522                                     ffetargetComplex2 l,
 523                                     ffetargetComplex2 r);
 524 #endif
 525 #if FFETARGET_okCOMPLEX3
 526 ffebad ffetarget_multiply_complex3 (ffetargetComplex3 *res,
 527                                     ffetargetComplex3 l,
 528                                     ffetargetComplex3 r);
 529 #endif
 530 ffebad ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault *res,
 531                                                   ffetargetComplexDefault l,
 532                                                  ffetargetIntegerDefault r);
 533 #if FFETARGET_okCOMPLEXDOUBLE
 534 ffebad ffetarget_power_complexdouble_integerdefault (ffetargetComplexDouble *res,
 535                                                    ffetargetComplexDouble l,
 536                                                  ffetargetIntegerDefault r);
 537 #endif
 538 ffebad ffetarget_power_integerdefault_integerdefault (ffetargetIntegerDefault *res,
 539                                                   ffetargetIntegerDefault l,
 540                                                  ffetargetIntegerDefault r);
 541 ffebad ffetarget_power_realdefault_integerdefault (ffetargetRealDefault *res,
 542                                                    ffetargetRealDefault l,
 543                                                  ffetargetIntegerDefault r);
 544 ffebad ffetarget_power_realdouble_integerdefault (ffetargetRealDouble *res,
 545                                                   ffetargetRealDouble l,
 546                                                   ffetargetIntegerDefault r);
 547 void ffetarget_print_binary (FILE *f, ffetargetTypeless val);
 548 void ffetarget_print_character1 (FILE *f, ffetargetCharacter1 val);
 549 void ffetarget_print_hollerith (FILE *f, ffetargetHollerith val);
 550 void ffetarget_print_octal (FILE *f, ffetargetTypeless val);
 551 void ffetarget_print_hex (FILE *f, ffetargetTypeless val);
 552 #if FFETARGET_okREAL1
 553 bool ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer,
 554                       ffelexToken decimal, ffelexToken fraction,
 555                       ffelexToken exponent, ffelexToken exponent_sign,
 556                       ffelexToken exponent_digits);
 557 #endif
 558 #if FFETARGET_okREAL2
 559 bool ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer,
 560                       ffelexToken decimal, ffelexToken fraction,
 561                       ffelexToken exponent, ffelexToken exponent_sign,
 562                       ffelexToken exponent_digits);
 563 #endif
 564 #if FFETARGET_okREAL3
 565 bool ffetarget_real3 (ffetargetReal3 *value, ffelexToken integer,
 566                       ffelexToken decimal, ffelexToken fraction,
 567                       ffelexToken exponent, ffelexToken exponent_sign,
 568                       ffelexToken exponent_digits);
 569 #endif
 570 bool ffetarget_typeless_binary (ffetargetTypeless *value, ffelexToken token);
 571 bool ffetarget_typeless_octal (ffetargetTypeless *value, ffelexToken token);
 572 bool ffetarget_typeless_hex (ffetargetTypeless *value, ffelexToken token);
 573 void ffetarget_verify_character1 (mallocPool pool, ffetargetCharacter1 val);
 574 int ffetarget_num_digits_ (ffelexToken t);
 575 void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
 576
 577 /* Define macros. */
 578
 579 #define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt)            \
 580   REAL_VALUE_FROM_INT (resr, (HOST_WIDE_INT) lf,                \
 581                        (HOST_WIDE_INT) ((lf < 0) ? -1 : 0),     \
 582                        mode_for_size (kt == 1 ? 32 : 64, MODE_FLOAT, 0))
 583
 584 #if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
 585 #define FFETARGET_REAL_VALUE_FROM_LONGLONG_(resr, lf, kt)               \
 586   REAL_VALUE_FROM_INT (resr, (HOST_WIDE_INT) lf,                        \
 587                        (HOST_WIDE_INT) (lf >> HOST_BITS_PER_WIDE_INT),  \
 588                        mode_for_size (kt == 1 ? 32 : 64, MODE_FLOAT, 0))
 589 #define FFETARGET_LONGLONG_FROM_INTS_(hi, lo)           \
 590   (((long long int) hi << HOST_BITS_PER_WIDE_INT)       \
 591    | (long long int) ((unsigned HOST_WIDE_INT) lo))
 592 #else
 593 #define FFETARGET_REAL_VALUE_FROM_LONGLONG_(resr, lf, kt)               \
 594   FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, kt)
 595 #define FFETARGET_LONGLONG_FROM_INTS_(hi, lo)  lo
 596 #endif
 597
 598 #define ffetarget_add_complex1(res,l,r) \
 599   ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
 600      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
 601      li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
 602      rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
 603      ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
 604      REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
 605      REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
 606      ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
 607      ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
 608      FFEBAD; })
 609 #define ffetarget_add_complex2(res,l,r) \
 610   ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
 611      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
 612      li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
 613      rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
 614      ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
 615      REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
 616      REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
 617      ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
 618      ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
 619      FFEBAD; })
 620 #define ffetarget_add_integer1(res,l,r) (*(res) = (l) + (r), FFEBAD)
 621 #define ffetarget_add_integer2(res,l,r) (*(res) = (l) + (r), FFEBAD)
 622 #define ffetarget_add_integer3(res,l,r) (*(res) = (l) + (r), FFEBAD)
 623 #define ffetarget_add_integer4(res,l,r) (*(res) = (l) + (r), FFEBAD)
 624 #define ffetarget_add_real1(res,l,r) \
 625   ({ REAL_VALUE_TYPE lr, rr, resr; \
 626      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
 627      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
 628      REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
 629      ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
 630      FFEBAD; })
 631 #define ffetarget_add_real2(res,l,r) \
 632   ({ REAL_VALUE_TYPE lr, rr, resr; \
 633      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
 634      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
 635      REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
 636      ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
 637      FFEBAD; })
 638 #define ffetarget_aggregate_ptr_memcpy(dbt,dkt,sbt,skt) \
 639   ((ffetargetCopyfunc) ffetarget_memcpy_)
 640 #define ffetarget_and_integer1(res,l,r) (*(res) = (l) & (r), FFEBAD)
 641 #define ffetarget_and_integer2(res,l,r) (*(res) = (l) & (r), FFEBAD)
 642 #define ffetarget_and_integer3(res,l,r) (*(res) = (l) & (r), FFEBAD)
 643 #define ffetarget_and_integer4(res,l,r) (*(res) = (l) & (r), FFEBAD)
 644 #define ffetarget_and_logical1(res,l,r) (*(res) = (l) && (r), FFEBAD)
 645 #define ffetarget_and_logical2(res,l,r) (*(res) = (l) && (r), FFEBAD)
 646 #define ffetarget_and_logical3(res,l,r) (*(res) = (l) && (r), FFEBAD)
 647 #define ffetarget_and_logical4(res,l,r) (*(res) = (l) && (r), FFEBAD)
 648 #define ffetarget_binarymil(v,t) ffetarget_typeless_binary (v, t)
 649 #define ffetarget_binaryvxt(v,t) ffetarget_typeless_binary (v, t)
 650 #define ffetarget_cmp_integer1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 651 #define ffetarget_cmp_integer2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 652 #define ffetarget_cmp_integer3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 653 #define ffetarget_cmp_integer4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 654 #define ffetarget_cmp_logical1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 655 #define ffetarget_cmp_logical2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 656 #define ffetarget_cmp_logical3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 657 #define ffetarget_cmp_logical4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
 658 #define ffetarget_cmp_real1(l,r) memcmp (&(l), &(r), sizeof(l))
 659 #define ffetarget_cmp_real2(l,r) memcmp (&(l), &(r), sizeof(l))
 660 #define ffetarget_cmp_real3(l,r) memcmp (&(l), &(r), sizeof(l))
 661 #define ffetarget_cmp_typeless(l,r) \
 662   memcmp (&(l), &(r), sizeof ((l)))
 663 #define ffetarget_convert_character1_integer1(res,res_size,l,pool) \
 664         ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
 665 #define ffetarget_convert_character1_integer2(res,res_size,l,pool) \
 666         ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
 667 #define ffetarget_convert_character1_integer3(res,res_size,l,pool) \
 668         ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
 669 #define ffetarget_convert_character1_logical1(res,res_size,l,pool) \
 670         ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
 671 #define ffetarget_convert_character1_logical2(res,res_size,l,pool) \
 672         ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
 673 #define ffetarget_convert_character1_logical3(res,res_size,l,pool) \
 674         ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
 675 #define ffetarget_convert_complex1_character1(res,l) \
 676   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 677 #define ffetarget_convert_complex1_hollerith(res,l) \
 678   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 679 #define ffetarget_convert_complex1_typeless(res,l) \
 680   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 681 #define ffetarget_convert_complex1_complex2(res,l) \
 682   ({ REAL_VALUE_TYPE lr, li; \
 683      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
 684      li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
 685      ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
 686      ffetarget_cvt_rv_to_r1_ (li, (res)->imaginary), \
 687      FFEBAD; })
 688 #define ffetarget_convert_complex1_integer(res,l) \
 689   ({ REAL_VALUE_TYPE resi, resr; \
 690      ffetargetInteger1 lf = (l); \
 691      FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
 692      resi = dconst0; \
 693      ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
 694      ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
 695      FFEBAD; })
 696 #define ffetarget_convert_complex1_integer1 ffetarget_convert_complex1_integer
 697 #define ffetarget_convert_complex1_integer2 ffetarget_convert_complex1_integer
 698 #define ffetarget_convert_complex1_integer3 ffetarget_convert_complex1_integer
 699 #define ffetarget_convert_complex1_integer4(res,l) \
 700   ({ REAL_VALUE_TYPE resi, resr; \
 701      ffetargetInteger4 lf = (l); \
 702      FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 1); \
 703      resi = dconst0; \
 704      ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
 705      ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
 706      FFEBAD; })
 707 #define ffetarget_convert_complex1_real1(res,l) \
 708   ((res)->real = (l), \
 709    ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
 710    FFEBAD)
 711 #define ffetarget_convert_complex1_real2(res,l) \
 712   ({ REAL_VALUE_TYPE lr; \
 713      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
 714      ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
 715      ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
 716      FFEBAD; })
 717 #define ffetarget_convert_complex2_character1(res,l) \
 718   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 719 #define ffetarget_convert_complex2_hollerith(res,l) \
 720   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 721 #define ffetarget_convert_complex2_typeless(res,l) \
 722   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 723 #define ffetarget_convert_complex2_complex1(res,l) \
 724   ({ REAL_VALUE_TYPE lr, li; \
 725      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
 726      li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
 727      ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
 728      ffetarget_cvt_rv_to_r2_ (li, &((res)->imaginary.v[0])), \
 729      FFEBAD; })
 730 #define ffetarget_convert_complex2_integer(res,l) \
 731   ({ REAL_VALUE_TYPE resi, resr; \
 732      ffetargetInteger1 lf = (l); \
 733      FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
 734      resi = dconst0; \
 735      ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
 736      ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
 737      FFEBAD; })
 738 #define ffetarget_convert_complex2_integer1 ffetarget_convert_complex2_integer
 739 #define ffetarget_convert_complex2_integer2 ffetarget_convert_complex2_integer
 740 #define ffetarget_convert_complex2_integer3 ffetarget_convert_complex2_integer
 741 #define ffetarget_convert_complex2_integer4(res,l) \
 742   ({ REAL_VALUE_TYPE resi, resr; \
 743      ffetargetInteger4 lf = (l); \
 744      FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 2); \
 745      resi = dconst0; \
 746      ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
 747      ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
 748      FFEBAD; })
 749 #define ffetarget_convert_complex2_real1(res,l) \
 750   ({ REAL_VALUE_TYPE lr; \
 751      lr = ffetarget_cvt_r1_to_rv_ (l); \
 752      ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
 753      ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
 754      FFEBAD; })
 755 #define ffetarget_convert_complex2_real2(res,l) \
 756   ((res)->real = (l), \
 757    ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
 758    FFEBAD)
 759 #define ffetarget_convert_integer2_character1(res,l) \
 760         ffetarget_convert_integer1_character1(res,l)
 761 #define ffetarget_convert_integer2_complex1(res,l) \
 762         ffetarget_convert_integer1_complex1(res,l)
 763 #define ffetarget_convert_integer2_complex2(res,l) \
 764         ffetarget_convert_integer1_complex2(res,l)
 765 #define ffetarget_convert_integer2_hollerith(res,l) \
 766         ffetarget_convert_integer1_hollerith(res,l)
 767 #define ffetarget_convert_integer2_integer1(res,l) (*(res) = (l), FFEBAD)
 768 #define ffetarget_convert_integer2_integer3(res,l) (*(res) = (l), FFEBAD)
 769 #define ffetarget_convert_integer2_integer4(res,l) (*(res) = (l), FFEBAD)
 770 #define ffetarget_convert_integer2_logical1(res,l) \
 771         ffetarget_convert_integer1_logical1(res,l)
 772 #define ffetarget_convert_integer2_logical2(res,l) \
 773         ffetarget_convert_integer2_logical1(res,l)
 774 #define ffetarget_convert_integer2_logical3(res,l) \
 775         ffetarget_convert_integer2_logical1(res,l)
 776 #define ffetarget_convert_integer2_logical4(res,l) \
 777         ffetarget_convert_integer2_logical1(res,l)
 778 #define ffetarget_convert_integer2_real1(res,l) \
 779         ffetarget_convert_integer1_real1(res,l)
 780 #define ffetarget_convert_integer2_real2(res,l) \
 781         ffetarget_convert_integer1_real2(res,l)
 782 #define ffetarget_convert_integer2_typeless(res,l) \
 783         ffetarget_convert_integer1_typeless(res,l)
 784 #define ffetarget_convert_integer3_character1(res,l) \
 785         ffetarget_convert_integer1_character1(res,l)
 786 #define ffetarget_convert_integer3_complex1(res,l) \
 787         ffetarget_convert_integer1_complex1(res,l)
 788 #define ffetarget_convert_integer3_complex2(res,l) \
 789         ffetarget_convert_integer1_complex2(res,l)
 790 #define ffetarget_convert_integer3_hollerith(res,l) \
 791         ffetarget_convert_integer1_hollerith(res,l)
 792 #define ffetarget_convert_integer3_integer1(res,l) (*(res) = (l), FFEBAD)
 793 #define ffetarget_convert_integer3_integer2(res,l) (*(res) = (l), FFEBAD)
 794 #define ffetarget_convert_integer3_integer4(res,l) (*(res) = (l), FFEBAD)
 795 #define ffetarget_convert_integer3_logical1(res,l) \
 796         ffetarget_convert_integer1_logical1(res,l)
 797 #define ffetarget_convert_integer3_logical2(res,l) \
 798         ffetarget_convert_integer3_logical1(res,l)
 799 #define ffetarget_convert_integer3_logical3(res,l) \
 800         ffetarget_convert_integer3_logical1(res,l)
 801 #define ffetarget_convert_integer3_logical4(res,l) \
 802         ffetarget_convert_integer3_logical1(res,l)
 803 #define ffetarget_convert_integer3_real1(res,l) \
 804         ffetarget_convert_integer1_real1(res,l)
 805 #define ffetarget_convert_integer3_real2(res,l) \
 806         ffetarget_convert_integer1_real2(res,l)
 807 #define ffetarget_convert_integer3_typeless(res,l) \
 808         ffetarget_convert_integer1_typeless(res,l)
 809 #define ffetarget_convert_integer4_character1(res,l) \
 810         ffetarget_convert_integer1_character1(res,l)
 811 #define ffetarget_convert_integer4_complex1(res,l) \
 812   ({ REAL_VALUE_TYPE lr; \
 813      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
 814      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 815      *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_,  \
 816                                              ffetarget_long_val_); \
 817      FFEBAD; })
 818 #define ffetarget_convert_integer4_complex2(res,l) \
 819   ({ REAL_VALUE_TYPE lr; \
 820      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
 821      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 822      *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_,  \
 823                                              ffetarget_long_val_); \
 824      FFEBAD; })
 825 #define ffetarget_convert_integer4_hollerith(res,l) \
 826         ffetarget_convert_integer1_hollerith(res,l)
 827 #define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD)
 828 #define ffetarget_convert_integer4_integer2(res,l) (*(res) = (l), FFEBAD)
 829 #define ffetarget_convert_integer4_integer3(res,l) (*(res) = (l), FFEBAD)
 830 #define ffetarget_convert_integer4_logical1(res,l) \
 831         ffetarget_convert_integer1_logical1(res,l)
 832 #define ffetarget_convert_integer4_logical2(res,l) \
 833         ffetarget_convert_integer1_logical1(res,l)
 834 #define ffetarget_convert_integer4_logical3(res,l) \
 835         ffetarget_convert_integer1_logical1(res,l)
 836 #define ffetarget_convert_integer4_logical4(res,l) \
 837         ffetarget_convert_integer1_logical1(res,l)
 838 #define ffetarget_convert_integer4_real1(res,l) \
 839   ({ REAL_VALUE_TYPE lr; \
 840      lr = ffetarget_cvt_r1_to_rv_ (l); \
 841      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 842      *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \
 843                                              ffetarget_long_val_); \
 844      FFEBAD; })
 845 #define ffetarget_convert_integer4_real2(res,l) \
 846   ({ REAL_VALUE_TYPE lr; \
 847      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
 848      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 849      *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \
 850                                              ffetarget_long_val_); \
 851      FFEBAD; })
 852 #define ffetarget_convert_integer4_typeless(res,l) \
 853         ffetarget_convert_integer1_typeless(res,l)
 854 #define ffetarget_convert_logical1_character1(res,l) \
 855   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 856 #define ffetarget_convert_logical1_hollerith(res,l) \
 857   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 858 #define ffetarget_convert_logical1_typeless(res,l) \
 859   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 860 #define ffetarget_convert_logical1_logical2(res,l) (*(res) = (l), FFEBAD)
 861 #define ffetarget_convert_logical1_logical3(res,l) (*(res) = (l), FFEBAD)
 862 #define ffetarget_convert_logical1_logical4(res,l) (*(res) = (l), FFEBAD)
 863 #define ffetarget_convert_logical1_integer1(res,l) (*(res) = (l), FFEBAD)
 864 #define ffetarget_convert_logical1_integer2(res,l) (*(res) = (l), FFEBAD)
 865 #define ffetarget_convert_logical1_integer3(res,l) (*(res) = (l), FFEBAD)
 866 #define ffetarget_convert_logical1_integer4(res,l) (*(res) = (l), FFEBAD)
 867 #define ffetarget_convert_logical2_character1(res,l) \
 868   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 869 #define ffetarget_convert_logical2_hollerith(res,l) \
 870   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 871 #define ffetarget_convert_logical2_typeless(res,l) \
 872   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 873 #define ffetarget_convert_logical2_logical1(res,l) (*(res) = (l), FFEBAD)
 874 #define ffetarget_convert_logical2_logical3(res,l) (*(res) = (l), FFEBAD)
 875 #define ffetarget_convert_logical2_logical4(res,l) (*(res) = (l), FFEBAD)
 876 #define ffetarget_convert_logical2_integer1(res,l) (*(res) = (l), FFEBAD)
 877 #define ffetarget_convert_logical2_integer2(res,l) (*(res) = (l), FFEBAD)
 878 #define ffetarget_convert_logical2_integer3(res,l) (*(res) = (l), FFEBAD)
 879 #define ffetarget_convert_logical2_integer4(res,l) (*(res) = (l), FFEBAD)
 880 #define ffetarget_convert_logical3_character1(res,l) \
 881   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 882 #define ffetarget_convert_logical3_hollerith(res,l) \
 883   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 884 #define ffetarget_convert_logical3_typeless(res,l) \
 885   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 886 #define ffetarget_convert_logical3_logical1(res,l) (*(res) = (l), FFEBAD)
 887 #define ffetarget_convert_logical3_logical2(res,l) (*(res) = (l), FFEBAD)
 888 #define ffetarget_convert_logical3_logical4(res,l) (*(res) = (l), FFEBAD)
 889 #define ffetarget_convert_logical3_integer1(res,l) (*(res) = (l), FFEBAD)
 890 #define ffetarget_convert_logical3_integer2(res,l) (*(res) = (l), FFEBAD)
 891 #define ffetarget_convert_logical3_integer3(res,l) (*(res) = (l), FFEBAD)
 892 #define ffetarget_convert_logical3_integer4(res,l) (*(res) = (l), FFEBAD)
 893 #define ffetarget_convert_logical4_character1(res,l) \
 894   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 895 #define ffetarget_convert_logical4_hollerith(res,l) \
 896   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 897 #define ffetarget_convert_logical4_typeless(res,l) \
 898   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 899 #define ffetarget_convert_logical4_logical1(res,l) (*(res) = (l), FFEBAD)
 900 #define ffetarget_convert_logical4_logical2(res,l) (*(res) = (l), FFEBAD)
 901 #define ffetarget_convert_logical4_logical3(res,l) (*(res) = (l), FFEBAD)
 902 #define ffetarget_convert_logical4_integer1(res,l) (*(res) = (l), FFEBAD)
 903 #define ffetarget_convert_logical4_integer2(res,l) (*(res) = (l), FFEBAD)
 904 #define ffetarget_convert_logical4_integer3(res,l) (*(res) = (l), FFEBAD)
 905 #define ffetarget_convert_logical4_integer4(res,l) (*(res) = (l), FFEBAD)
 906 #define ffetarget_convert_integer1_character1(res,l) \
 907   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 908 #define ffetarget_convert_integer1_hollerith(res,l) \
 909   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 910 #define ffetarget_convert_integer1_typeless(res,l) \
 911   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 912 #define ffetarget_convert_integer1_integer2(res,l) (*(res) = (l), FFEBAD)
 913 #define ffetarget_convert_integer1_integer3(res,l) (*(res) = (l), FFEBAD)
 914 #define ffetarget_convert_integer1_integer4(res,l) (*(res) = (l), FFEBAD)
 915 #define ffetarget_convert_integer1_logical1(res,l) (*(res) = (l), FFEBAD)
 916 #define ffetarget_convert_integer1_logical2(res,l) (*(res) = (l), FFEBAD)
 917 #define ffetarget_convert_integer1_logical3(res,l) (*(res) = (l), FFEBAD)
 918 #define ffetarget_convert_integer1_logical4(res,l) (*(res) = (l), FFEBAD)
 919 #define ffetarget_convert_integer1_real1(res,l) \
 920   ({ REAL_VALUE_TYPE lr; \
 921      lr = ffetarget_cvt_r1_to_rv_ (l); \
 922      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 923      *(res) = ffetarget_long_val_; \
 924      FFEBAD; })
 925 #define ffetarget_convert_integer1_real2(res,l) \
 926   ({ REAL_VALUE_TYPE lr; \
 927      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
 928      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 929      *(res) = ffetarget_long_val_; \
 930      FFEBAD; })
 931 #define ffetarget_convert_integer1_complex1(res,l) \
 932   ({ REAL_VALUE_TYPE lr; \
 933      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
 934      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 935      *(res) = ffetarget_long_val_; \
 936      FFEBAD; })
 937 #define ffetarget_convert_integer1_complex2(res,l) \
 938   ({ REAL_VALUE_TYPE lr; \
 939      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
 940      REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
 941      *(res) = ffetarget_long_val_; \
 942      FFEBAD; })
 943 #define ffetarget_convert_real1_character1(res,l) \
 944   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 945 #define ffetarget_convert_real1_hollerith(res,l) \
 946   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 947 #define ffetarget_convert_real1_integer2(res,l) \
 948         ffetarget_convert_real1_integer1(res,l)
 949 #define ffetarget_convert_real1_integer3(res,l) \
 950         ffetarget_convert_real1_integer1(res,l)
 951 #define ffetarget_convert_real1_integer4(res,l) \
 952   ({ REAL_VALUE_TYPE resr; \
 953      ffetargetInteger4 lf = (l); \
 954      FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 1); \
 955      ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
 956      FFEBAD; })
 957 #define ffetarget_convert_real1_typeless(res,l) \
 958   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 959 #define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD)
 960 #define ffetarget_convert_real1_complex2(res,l) \
 961   ffetarget_convert_real1_real2 ((res), (l).real)
 962 #define ffetarget_convert_real1_integer1(res,l) \
 963   ({ REAL_VALUE_TYPE resr; \
 964      ffetargetInteger1 lf = (l); \
 965      FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
 966      ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
 967      FFEBAD; })
 968 #define ffetarget_convert_real1_real2(res,l) \
 969   ({ REAL_VALUE_TYPE lr; \
 970      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
 971      ffetarget_cvt_rv_to_r1_ (lr, *(res)); \
 972      FFEBAD; })
 973 #define ffetarget_convert_real2_character1(res,l) \
 974   ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
 975 #define ffetarget_convert_real2_hollerith(res,l) \
 976   ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
 977 #define ffetarget_convert_real2_integer2(res,l) \
 978         ffetarget_convert_real2_integer1(res,l)
 979 #define ffetarget_convert_real2_integer3(res,l) \
 980         ffetarget_convert_real2_integer1(res,l)
 981 #define ffetarget_convert_real2_integer4(res,l) \
 982   ({ REAL_VALUE_TYPE resr; \
 983      ffetargetInteger4 lf = (l); \
 984      FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 2); \
 985      ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
 986      FFEBAD; })
 987 #define ffetarget_convert_real2_typeless(res,l) \
 988   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 989 #define ffetarget_convert_real2_complex1(res,l) \
 990   ffetarget_convert_real2_real1 ((res), (l).real)
 991 #define ffetarget_convert_real2_complex2(res,l) (*(res) = (l).real, FFEBAD)
 992 #define ffetarget_convert_real2_integer(res,l) \
 993   ({ REAL_VALUE_TYPE resr; \
 994      ffetargetInteger1 lf = (l); \
 995      FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
 996      ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
 997      FFEBAD; })
 998 #define ffetarget_convert_real2_integer1 ffetarget_convert_real2_integer
 999 #define ffetarget_convert_real2_real1(res,l) \
1000   ({ REAL_VALUE_TYPE lr; \
1001      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1002      ffetarget_cvt_rv_to_r2_ (lr, &((res)->v[0])); \
1003      FFEBAD; })
1004 #define ffetarget_divide_integer1(res,l,r) \
1005   (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO)  \
1006    : (((r) == -1) ? (*(res) = -(l), FFEBAD)       \
1007       : (*(res) = (l) / (r), FFEBAD)))
1008 #define ffetarget_divide_integer2(res,l,r) \
1009         ffetarget_divide_integer1(res,l,r)
1010 #define ffetarget_divide_integer3(res,l,r) \
1011         ffetarget_divide_integer1(res,l,r)
1012 #define ffetarget_divide_integer4(res,l,r) \
1013         ffetarget_divide_integer1(res,l,r)
1014 #define ffetarget_divide_real1(res,l,r) \
1015   ({ REAL_VALUE_TYPE lr, rr, resr; \
1016      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1017      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1018      REAL_VALUES_EQUAL (rr, dconst0) \
1019        ? ({ ffetarget_cvt_rv_to_r1_ (dconst0, *(res)); \
1020             FFEBAD_DIV_BY_ZERO; \
1021           }) \
1022          : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
1023               ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1024               FFEBAD; \
1025             }); \
1026          })
1027 #define ffetarget_divide_real2(res,l,r) \
1028   ({ REAL_VALUE_TYPE lr, rr, resr; \
1029      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1030      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1031      REAL_VALUES_EQUAL (rr, dconst0) \
1032        ? ({ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0])); \
1033             FFEBAD_DIV_BY_ZERO; \
1034           }) \
1035          : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
1036               ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1037               FFEBAD; \
1038             }); \
1039          })
1040 #define ffetarget_eq_complex1(res,l,r) \
1041   ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1042      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1043      li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1044      rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1045      ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1046      *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1047        ? TRUE : FALSE; \
1048      FFEBAD; })
1049 #define ffetarget_eq_complex2(res,l,r) \
1050   ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1051      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1052      li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1053      rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1054      ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1055      *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1056        ? TRUE : FALSE; \
1057      FFEBAD; })
1058 #define ffetarget_eq_integer1(res,l,r) \
1059   (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1060 #define ffetarget_eq_integer2(res,l,r) \
1061   (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1062 #define ffetarget_eq_integer3(res,l,r) \
1063   (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1064 #define ffetarget_eq_integer4(res,l,r) \
1065   (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1066 #define ffetarget_eq_real1(res,l,r) \
1067   ({ REAL_VALUE_TYPE lr, rr; \
1068      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1069      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1070      *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
1071      FFEBAD; })
1072 #define ffetarget_eq_real2(res,l,r) \
1073   ({ REAL_VALUE_TYPE lr, rr; \
1074      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1075      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1076      *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
1077      FFEBAD; })
1078 #define ffetarget_eqv_integer1(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1079 #define ffetarget_eqv_integer2(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1080 #define ffetarget_eqv_integer3(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1081 #define ffetarget_eqv_integer4(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1082 #define ffetarget_eqv_logical1(res,l,r) (*(res) = (l) == (r), FFEBAD)
1083 #define ffetarget_eqv_logical2(res,l,r) (*(res) = (l) == (r), FFEBAD)
1084 #define ffetarget_eqv_logical3(res,l,r) (*(res) = (l) == (r), FFEBAD)
1085 #define ffetarget_eqv_logical4(res,l,r) (*(res) = (l) == (r), FFEBAD)
1086 #define ffetarget_ge_integer1(res,l,r) \
1087   (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1088 #define ffetarget_ge_integer2(res,l,r) \
1089   (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1090 #define ffetarget_ge_integer3(res,l,r) \
1091   (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1092 #define ffetarget_ge_integer4(res,l,r) \
1093   (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1094 #define ffetarget_ge_real1(res,l,r) \
1095   ({ REAL_VALUE_TYPE lr, rr; \
1096      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1097      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1098      *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
1099      FFEBAD; })
1100 #define ffetarget_ge_real2(res,l,r) \
1101   ({ REAL_VALUE_TYPE lr, rr; \
1102      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1103      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1104      *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
1105      FFEBAD; })
1106 #define ffetarget_gt_integer1(res,l,r) \
1107   (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1108 #define ffetarget_gt_integer2(res,l,r) \
1109   (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1110 #define ffetarget_gt_integer3(res,l,r) \
1111   (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1112 #define ffetarget_gt_integer4(res,l,r) \
1113   (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1114 #define ffetarget_gt_real1(res,l,r) \
1115   ({ REAL_VALUE_TYPE lr, rr; \
1116      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1117      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1118      *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1119        ? FALSE : TRUE; \
1120      FFEBAD; })
1121 #define ffetarget_gt_real2(res,l,r) \
1122   ({ REAL_VALUE_TYPE lr, rr; \
1123      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1124      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1125      *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1126        ? FALSE : TRUE; \
1127      FFEBAD; })
1128 #define ffetarget_hexxmil(v,t) ffetarget_typeless_hex (v, t)
1129 #define ffetarget_hexxvxt(v,t) ffetarget_typeless_hex (v, t)
1130 #define ffetarget_hexzmil(v,t) ffetarget_typeless_hex (v, t)
1131 #define ffetarget_hexzvxt(v,t) ffetarget_typeless_hex (v, t)
1132 #define ffetarget_init_0()
1133 #define ffetarget_init_1()
1134 #define ffetarget_init_2()
1135 #define ffetarget_init_3()
1136 #define ffetarget_init_4()
1137 #ifdef FFETARGET_32bit_longs
1138 #define ffetarget_integerdefault_is_magical(i) \
1139   (((unsigned long int) i) == FFETARGET_integerBIG_MAGICAL)
1140 #else
1141 #define ffetarget_integerdefault_is_magical(i) \
1142   (((unsigned int) i) == FFETARGET_integerBIG_MAGICAL)
1143 #endif
1144 #define ffetarget_iszero_real1(l) \
1145   ({ REAL_VALUE_TYPE lr; \
1146      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1147      REAL_VALUES_EQUAL (lr, dconst0); \
1148    })
1149 #define ffetarget_iszero_real2(l) \
1150   ({ REAL_VALUE_TYPE lr; \
1151      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1152      REAL_VALUES_EQUAL (lr, dconst0); \
1153    })
1154 #define ffetarget_iszero_typeless(l) ((l) == 0)
1155 #define ffetarget_logical1(v,truth) (*(v) = truth ? 1 : 0)
1156 #define ffetarget_le_integer1(res,l,r) \
1157   (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1158 #define ffetarget_le_integer2(res,l,r) \
1159   (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1160 #define ffetarget_le_integer3(res,l,r) \
1161   (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1162 #define ffetarget_le_integer4(res,l,r) \
1163   (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1164 #define ffetarget_le_real1(res,l,r) \
1165   ({ REAL_VALUE_TYPE lr, rr; \
1166      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1167      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1168      *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1169        ? TRUE : FALSE; \
1170      FFEBAD; })
1171 #define ffetarget_le_real2(res,l,r) \
1172   ({ REAL_VALUE_TYPE lr, rr; \
1173      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1174      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1175      *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1176        ? TRUE : FALSE; \
1177      FFEBAD; })
1178 #define ffetarget_lt_integer1(res,l,r) \
1179   (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1180 #define ffetarget_lt_integer2(res,l,r) \
1181   (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1182 #define ffetarget_lt_integer3(res,l,r) \
1183   (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1184 #define ffetarget_lt_integer4(res,l,r) \
1185   (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1186 #define ffetarget_lt_real1(res,l,r) \
1187   ({ REAL_VALUE_TYPE lr, rr; \
1188      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1189      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1190      *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
1191      FFEBAD; })
1192 #define ffetarget_lt_real2(res,l,r) \
1193   ({ REAL_VALUE_TYPE lr, rr; \
1194      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1195      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1196      *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
1197      FFEBAD; })
1198 #define ffetarget_length_character1(c) ((c).length)
1199 #define ffetarget_length_characterdefault ffetarget_length_character1
1200 #define ffetarget_make_real1(res,lr) \
1201   ffetarget_cvt_rv_to_r1_ ((lr), *(res))
1202 #define ffetarget_make_real2(res,lr) \
1203   ffetarget_cvt_rv_to_r2_ ((lr), &((res)->v[0]))
1204 #define ffetarget_multiply_integer1(res,l,r) (*(res) = (l) * (r), FFEBAD)
1205 #define ffetarget_multiply_integer2(res,l,r) (*(res) = (l) * (r), FFEBAD)
1206 #define ffetarget_multiply_integer3(res,l,r) (*(res) = (l) * (r), FFEBAD)
1207 #define ffetarget_multiply_integer4(res,l,r) (*(res) = (l) * (r), FFEBAD)
1208 #define ffetarget_multiply_real1(res,l,r) \
1209   ({ REAL_VALUE_TYPE lr, rr, resr; \
1210      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1211      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1212      REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
1213      ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1214      FFEBAD; })
1215 #define ffetarget_multiply_real2(res,l,r) \
1216   ({ REAL_VALUE_TYPE lr, rr, resr; \
1217      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1218      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1219      REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
1220      ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1221      FFEBAD; })
1222 #define ffetarget_ne_complex1(res,l,r) \
1223   ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1224      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1225      li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1226      rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1227      ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1228      *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1229        ? FALSE : TRUE; \
1230      FFEBAD; })
1231 #define ffetarget_ne_complex2(res,l,r) \
1232   ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1233      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1234      li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1235      rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1236      ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1237      *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1238        ? FALSE : TRUE; \
1239      FFEBAD; })
1240 #define ffetarget_ne_integer1(res,l,r) \
1241   (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1242 #define ffetarget_ne_integer2(res,l,r) \
1243   (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1244 #define ffetarget_ne_integer3(res,l,r) \
1245   (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1246 #define ffetarget_ne_integer4(res,l,r) \
1247   (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1248 #define ffetarget_ne_real1(res,l,r) \
1249   ({ REAL_VALUE_TYPE lr, rr; \
1250      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1251      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1252      *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
1253      FFEBAD; })
1254 #define ffetarget_ne_real2(res,l,r) \
1255   ({ REAL_VALUE_TYPE lr, rr; \
1256      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1257      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1258      *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
1259      FFEBAD; })
1260 #define ffetarget_neqv_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1261 #define ffetarget_neqv_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1262 #define ffetarget_neqv_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1263 #define ffetarget_neqv_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1264 #define ffetarget_neqv_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
1265 #define ffetarget_neqv_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
1266 #define ffetarget_neqv_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
1267 #define ffetarget_neqv_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
1268 #define ffetarget_not_integer1(res,l) (*(res) = ~(l), FFEBAD)
1269 #define ffetarget_not_integer2(res,l) (*(res) = ~(l), FFEBAD)
1270 #define ffetarget_not_integer3(res,l) (*(res) = ~(l), FFEBAD)
1271 #define ffetarget_not_integer4(res,l) (*(res) = ~(l), FFEBAD)
1272 #define ffetarget_not_logical1(res,l) (*(res) = !(l), FFEBAD)
1273 #define ffetarget_not_logical2(res,l) (*(res) = !(l), FFEBAD)
1274 #define ffetarget_not_logical3(res,l) (*(res) = !(l), FFEBAD)
1275 #define ffetarget_not_logical4(res,l) (*(res) = !(l), FFEBAD)
1276 #define ffetarget_octalmil(v,t) ffetarget_typeless_octal (v, t)
1277 #define ffetarget_octalvxt(v,t) ffetarget_typeless_octal (v, t)
1278 #define ffetarget_offset(res,l) (*(res) = (l), TRUE)    /* Overflow? */
1279 #define ffetarget_offset_add(res,l,r) (*(res) = (l) + (r), TRUE)        /* Overflow? */
1280 #define ffetarget_offset_charsize(res,l,u) (*(res) = (l) * (u), TRUE)   /* Ov? */
1281 #define ffetarget_offset_multiply(res,l,r) (*(res) = (l) * (r), TRUE)   /* Ov? */
1282 #define ffetarget_offset_overflow(text) ((void) 0)      /* ~~no message? */
1283 #define ffetarget_or_integer1(res,l,r) (*(res) = (l) | (r), FFEBAD)
1284 #define ffetarget_or_integer2(res,l,r) (*(res) = (l) | (r), FFEBAD)
1285 #define ffetarget_or_integer3(res,l,r) (*(res) = (l) | (r), FFEBAD)
1286 #define ffetarget_or_integer4(res,l,r) (*(res) = (l) | (r), FFEBAD)
1287 #define ffetarget_or_logical1(res,l,r) (*(res) = (l) || (r), FFEBAD)
1288 #define ffetarget_or_logical2(res,l,r) (*(res) = (l) || (r), FFEBAD)
1289 #define ffetarget_or_logical3(res,l,r) (*(res) = (l) || (r), FFEBAD)
1290 #define ffetarget_or_logical4(res,l,r) (*(res) = (l) || (r), FFEBAD)
1291 #define ffetarget_print_binarymil(f,v) ffetarget_print_binary (f, v)
1292 #define ffetarget_print_binaryvxt(f,v) ffetarget_print_binary (f, v)
1293 #define ffetarget_print_hexxmil(f,v) ffetarget_print_hex (f, v)
1294 #define ffetarget_print_hexxvxt(f,v) ffetarget_print_hex (f, v)
1295 #define ffetarget_print_hexzmil(f,v) ffetarget_print_hex (f, v)
1296 #define ffetarget_print_hexzvxt(f,v) ffetarget_print_hex (f, v)
1297 #define ffetarget_print_integer1(f,v) \
1298   fprintf ((f), "%" ffetargetInteger1_f "d", (v))
1299 #define ffetarget_print_integer2(f,v) \
1300   fprintf ((f), "%" ffetargetInteger2_f "d", (v))
1301 #define ffetarget_print_integer3(f,v) \
1302   fprintf ((f), "%" ffetargetInteger3_f "d", (v))
1303 #define ffetarget_print_integer4(f,v) \
1304   fprintf ((f), "%" ffetargetInteger4_f "d", (v))
1305 #define ffetarget_print_logical1(f,v) \
1306   fprintf ((f), "%" ffetargetLogical1_f "d", (v))
1307 #define ffetarget_print_logical2(f,v) \
1308   fprintf ((f), "%" ffetargetLogical2_f "d", (v))
1309 #define ffetarget_print_logical3(f,v) \
1310   fprintf ((f), "%" ffetargetLogical3_f "d", (v))
1311 #define ffetarget_print_logical4(f,v) \
1312   fprintf ((f), "%" ffetargetLogical4_f "d", (v))
1313 #define ffetarget_print_octalmil(f,v) ffetarget_print_octal(f,v)
1314 #define ffetarget_print_octalvxt(f,v) ffetarget_print_octal(f,v)
1315 #define ffetarget_print_real1(f,l) \
1316   ({ REAL_VALUE_TYPE lr; \
1317      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1318      real_to_decimal (ffetarget_string_, &lr \
1319                          sizeof(ffetarget_string_), 0, 1); \
1320      fputs (ffetarget_string_, (f)); \
1321    })
1322 #define ffetarget_print_real2(f,l) \
1323   ({ REAL_VALUE_TYPE lr; \
1324      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1325      real_to_decimal (ffetarget_string_, &lr, \
1326                          sizeof(ffetarget_string_), 0, 1); \
1327      fputs (ffetarget_string_, (f)); \
1328    })
1329 #define ffetarget_real1_one(res) ffetarget_cvt_rv_to_r1_ (dconst1, *(res))
1330 #define ffetarget_real2_one(res) ffetarget_cvt_rv_to_r2_ (dconst1, &((res)->v[0]))
1331 #define ffetarget_real1_two(res) ffetarget_cvt_rv_to_r1_ (dconst2, *(res))
1332 #define ffetarget_real2_two(res) ffetarget_cvt_rv_to_r2_ (dconst2, &((res)->v[0]))
1333 #define ffetarget_real1_zero(res) ffetarget_cvt_rv_to_r1_ (dconst0, *(res))
1334 #define ffetarget_real2_zero(res) ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0]))
1335 #define ffetarget_size_typeless_binary(t) ((ffetarget_num_digits_(t) + 7) / 8)
1336 #define ffetarget_size_typeless_octal(t) \
1337   ((ffetarget_num_digits_(t) * 3 + 7) / 8)
1338 #define ffetarget_size_typeless_hex(t) ((ffetarget_num_digits_(t) + 1) / 2)
1339 #define ffetarget_subtract_complex1(res,l,r) \
1340   ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
1341      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1342      li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1343      rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1344      ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1345      REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1346      REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
1347      ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
1348      ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
1349      FFEBAD; })
1350 #define ffetarget_subtract_complex2(res,l,r) \
1351   ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
1352      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1353      li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1354      rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1355      ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1356      REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1357      REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
1358      ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1359      ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1360      FFEBAD; })
1361 #define ffetarget_subtract_integer1(res,l,r) (*(res) = (l) - (r), FFEBAD)
1362 #define ffetarget_subtract_integer2(res,l,r) (*(res) = (l) - (r), FFEBAD)
1363 #define ffetarget_subtract_integer3(res,l,r) (*(res) = (l) - (r), FFEBAD)
1364 #define ffetarget_subtract_integer4(res,l,r) (*(res) = (l) - (r), FFEBAD)
1365 #define ffetarget_subtract_real1(res,l,r) \
1366   ({ REAL_VALUE_TYPE lr, rr, resr; \
1367      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1368      rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1369      REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1370      ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1371      FFEBAD; })
1372 #define ffetarget_subtract_real2(res,l,r) \
1373   ({ REAL_VALUE_TYPE lr, rr, resr; \
1374      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1375      rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1376      REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1377      ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1378      FFEBAD; })
1379 #define ffetarget_terminate_0()
1380 #define ffetarget_terminate_1()
1381 #define ffetarget_terminate_2()
1382 #define ffetarget_terminate_3()
1383 #define ffetarget_terminate_4()
1384 #define ffetarget_text_character1(c) ((c).text)
1385 #define ffetarget_text_characterdefault ffetarget_text_character1
1386 #define ffetarget_uminus_complex1(res,l) \
1387   ({ REAL_VALUE_TYPE lr, li, resr, resi; \
1388      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1389      li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1390      resr = REAL_VALUE_NEGATE (lr); \
1391      resi = REAL_VALUE_NEGATE (li); \
1392      ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
1393      ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
1394      FFEBAD; })
1395 #define ffetarget_uminus_complex2(res,l) \
1396   ({ REAL_VALUE_TYPE lr, li, resr, resi; \
1397      lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1398      li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1399      resr = REAL_VALUE_NEGATE (lr); \
1400      resi = REAL_VALUE_NEGATE (li); \
1401      ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1402      ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1403      FFEBAD; })
1404 #define ffetarget_uminus_integer1(res,l) (*(res) = -(l), FFEBAD)
1405 #define ffetarget_uminus_integer2(res,l) (*(res) = -(l), FFEBAD)
1406 #define ffetarget_uminus_integer3(res,l) (*(res) = -(l), FFEBAD)
1407 #define ffetarget_uminus_integer4(res,l) (*(res) = -(l), FFEBAD)
1408 #define ffetarget_uminus_real1(res,l) \
1409   ({ REAL_VALUE_TYPE lr, resr; \
1410      lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1411      resr = REAL_VALUE_NEGATE (lr); \
1412      ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1413      FFEBAD; })
1414 #define ffetarget_uminus_real2(res,l) \
1415   ({ REAL_VALUE_TYPE lr, resr; \
1416      lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1417      resr = REAL_VALUE_NEGATE (lr); \
1418      ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1419      FFEBAD; })
1420 #define ffetarget_value_real1(lr) ffetarget_cvt_r1_to_rv_ ((lr))
1421 #define ffetarget_value_real2(lr) ffetarget_cvt_r2_to_rv_ (&((lr).v[0]))
1422 #define ffetarget_xor_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1423 #define ffetarget_xor_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1424 #define ffetarget_xor_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1425 #define ffetarget_xor_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1426 #define ffetarget_xor_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
1427 #define ffetarget_xor_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
1428 #define ffetarget_xor_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
1429 #define ffetarget_xor_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
1430
1431 /* End of #include file. */
1432
1433 #endif /* ! GCC_F_TARGET_H */