1 /* target.h -- Public #include File (module.h template V1.0)
2 Copyright (C) 1995, 1996 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
5 This file is part of GNU Fortran.
7 GNU Fortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Fortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Fortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
28 /* Allow multiple inclusion to work. */
30 #ifndef GCC_F_TARGET_H
31 #define GCC_F_TARGET_H
34 #define HOST_WIDE_INT long
41 /* For now, g77 requires the ability to determine the exact bit pattern
42 of a float on the target machine. (Hopefully this will be changed
43 soon). Make sure we can do this. */
45 #if !defined (REAL_ARITHMETIC) \
46 && ((TARGET_FLOAT_FORMAT != HOST_FLOAT_FORMAT) \
47 || (FLOAT_WORDS_BIG_ENDIAN != HOST_FLOAT_WORDS_BIG_ENDIAN))
48 #error "g77 requires ability to access exact FP representation of target machine"
51 /* Simple definitions and enumerations. */
53 #define FFETARGET_charactersizeNONE (-1)
54 #ifndef FFETARGET_charactersizeMAXIMUM
55 #define FFETARGET_charactersizeMAXIMUM 2147483647
58 #ifndef FFETARGET_defaultIS_90
59 #define FFETARGET_defaultIS_90 0
61 #ifndef FFETARGET_defaultIS_AUTOMATIC
62 #define FFETARGET_defaultIS_AUTOMATIC 1
64 #ifndef FFETARGET_defaultIS_BACKSLASH
65 #define FFETARGET_defaultIS_BACKSLASH 1
67 #ifndef FFETARGET_defaultIS_INIT_LOCAL_ZERO
68 #define FFETARGET_defaultIS_INIT_LOCAL_ZERO 0
70 #ifndef FFETARGET_defaultIS_DOLLAR_OK
71 #define FFETARGET_defaultIS_DOLLAR_OK 0
73 #ifndef FFETARGET_defaultIS_F2C
74 #define FFETARGET_defaultIS_F2C 1
76 #ifndef FFETARGET_defaultIS_F2C_LIBRARY
77 #define FFETARGET_defaultIS_F2C_LIBRARY 1
79 #ifndef FFETARGET_defaultIS_FREE_FORM
80 #define FFETARGET_defaultIS_FREE_FORM 0
82 #ifndef FFETARGET_defaultIS_PEDANTIC
83 #define FFETARGET_defaultIS_PEDANTIC 0
85 #ifndef FFETARGET_defaultCASE_INTRIN
86 #define FFETARGET_defaultCASE_INTRIN FFE_caseLOWER
88 #ifndef FFETARGET_defaultCASE_MATCH
89 #define FFETARGET_defaultCASE_MATCH FFE_caseLOWER
91 #ifndef FFETARGET_defaultCASE_SOURCE
92 #define FFETARGET_defaultCASE_SOURCE FFE_caseLOWER
94 #ifndef FFETARGET_defaultCASE_SYMBOL
95 #define FFETARGET_defaultCASE_SYMBOL FFE_caseNONE
98 #ifndef FFETARGET_defaultFIXED_LINE_LENGTH
99 #define FFETARGET_defaultFIXED_LINE_LENGTH 72
102 /* 1 if external Fortran names ("FOO" in SUBROUTINE FOO, COMMON /FOO/,
103 and even enforced/default-for-unnamed PROGRAM, blank-COMMON, and
104 BLOCK DATA names, but not names of library functions implementing
105 intrinsics or names of local/internal variables) should have an
106 underscore appended (for compatibility with existing systems). */
108 #ifndef FFETARGET_defaultEXTERNAL_UNDERSCORED
109 #define FFETARGET_defaultEXTERNAL_UNDERSCORED 1
112 /* 1 if external Fortran names with underscores already in them should
113 have an extra underscore appended (in addition to the one they
114 might already have appened if FFETARGET_defaultEXTERNAL_UNDERSCORED). */
116 #ifndef FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED
117 #define FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED 1
120 /* If FFETARGET_defaultEXTERNAL_UNDERSCORED is 0, the following definitions
121 might also need to be overridden to make g77 objects compatible with
122 f2c+gcc objects. Although I don't think the unnamed BLOCK DATA one
123 is an issue at all. Of course, on some systems it isn't f2c
124 compatibility that is the issue -- maybe compatibility with some
125 other compiler(s). I don't know what to recommend for systems where
126 there is no existing Fortran compiler -- I suppose porting f2c and
127 pretending it's the existing one is best for now. */
129 /* 1 if the "FOO" in "PROGRAM FOO" should be overridden and a particular
130 name imposed in place of it in the actual code (normally the case,
131 because the library's main entry point on most systems calls the main
132 function by a particular name). Someday g77 might do the f2c trick
133 of also outputting a "FOO" procedure that just calls the main procedure,
134 but that'll wait until somebody shows why it is needed. */
136 #ifndef FFETARGET_isENFORCED_MAIN
137 #define FFETARGET_isENFORCED_MAIN 1
140 /* The enforced name of the main program if ENFORCED_MAIN is 1. */
142 #ifndef FFETARGET_nameENFORCED_MAIN_NAME
143 #define FFETARGET_nameENFORCED_MAIN_NAME "MAIN__"
146 /* The name used for an unnamed main program if ENFORCED_MAIN is 0. */
148 #ifndef FFETARGET_nameUNNAMED_MAIN
149 #define FFETARGET_nameUNNAMED_MAIN "MAIN__"
152 /* The name used for an unnamed block data program. */
154 #ifndef FFETARGET_nameUNNAMED_BLOCK_DATA
155 #define FFETARGET_nameUNNAMED_BLOCK_DATA "_BLOCK_DATA__"
158 /* The name used for blank common. */
160 #ifndef FFETARGET_nameBLANK_COMMON
161 #define FFETARGET_nameBLANK_COMMON "_BLNK__"
164 #ifndef FFETARGET_integerSMALLEST_POSITIVE
165 #define FFETARGET_integerSMALLEST_POSITIVE 0
167 #ifndef FFETARGET_integerLARGEST_POSITIVE
168 #define FFETARGET_integerLARGEST_POSITIVE 2147483647
170 #ifndef FFETARGET_integerBIG_MAGICAL
171 #define FFETARGET_integerBIG_MAGICAL 020000000000 /* 2147483648 */
173 #ifndef FFETARGET_integerALMOST_BIG_MAGICAL
174 #define FFETARGET_integerALMOST_BIG_MAGICAL 214748364
176 #ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY
177 #define FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY 0x80000000
179 #ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_HEX
180 #define FFETARGET_integerALMOST_BIG_OVERFLOW_HEX 0x10000000
182 #ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL
183 #define FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL 0x20000000
185 #ifndef FFETARGET_integerFINISH_BIG_MAGICAL
186 #define FFETARGET_integerFINISH_BIG_MAGICAL 8
188 #ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY
189 #define FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY 0
191 #ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_HEX
192 #define FFETARGET_integerFINISH_BIG_OVERFLOW_HEX 0
194 #ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL
195 #define FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL 0
198 #ifndef FFETARGET_offsetNONE
199 #define FFETARGET_offsetNONE 0 /* Not used by FFE, for backend if needed. */
202 #define FFETARGET_okINTEGER1 1
203 #define FFETARGET_okINTEGER2 1
204 #define FFETARGET_okINTEGER3 1
205 #define FFETARGET_okINTEGER4 1
206 #define FFETARGET_okLOGICAL1 1
207 #define FFETARGET_okLOGICAL2 1
208 #define FFETARGET_okLOGICAL3 1
209 #define FFETARGET_okLOGICAL4 1
210 #define FFETARGET_okREAL1 1
211 #define FFETARGET_okREAL2 1
212 #define FFETARGET_okREAL3 0
213 #define FFETARGET_okREALQUAD FFETARGET_okREAL3
214 #define FFETARGET_okCOMPLEX1 1
215 #define FFETARGET_okCOMPLEX2 1
216 #define FFETARGET_okCOMPLEX3 0
217 #define FFETARGET_okCOMPLEXDOUBLE FFETARGET_okCOMPLEX2
218 #define FFETARGET_okCOMPLEXQUAD FFETARGET_okCOMPLEX3
219 #define FFETARGET_okCHARACTER1 1
221 #define FFETARGET_f2cTYUNKNOWN 0
222 #define FFETARGET_f2cTYADDR 1
223 #define FFETARGET_f2cTYSHORT 2
224 #define FFETARGET_f2cTYLONG 3
225 #define FFETARGET_f2cTYREAL 4
226 #define FFETARGET_f2cTYDREAL 5
227 #define FFETARGET_f2cTYCOMPLEX 6
228 #define FFETARGET_f2cTYDCOMPLEX 7
229 #define FFETARGET_f2cTYLOGICAL 8
230 #define FFETARGET_f2cTYCHAR 9
231 #define FFETARGET_f2cTYSUBR 10
232 #define FFETARGET_f2cTYINT1 11
233 #define FFETARGET_f2cTYLOGICAL1 12
234 #define FFETARGET_f2cTYLOGICAL2 13
235 #define FFETARGET_f2cTYQUAD 14
237 #if !defined(__alpha__) && (!defined (_ARCH_PPC) || !defined (__64BIT__)) && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__))) && (!defined(__ia64__) || !defined(__LP64__))
238 #define FFETARGET_32bit_longs
243 typedef unsigned char ffetargetAlign
; /* ffetargetOffset for alignment. */
244 #define ffetargetAlign_f ""
245 typedef long ffetargetCharacterSize
;
246 #define ffetargetCharacterSize_f "l"
247 typedef void (*ffetargetCopyfunc
) (void *, void *, size_t);
248 typedef ffetargetCharacterSize ffetargetHollerithSize
;
249 #define ffetargetHollerithSize_f "l"
250 typedef long long ffetargetOffset
;
251 #define ffetargetOffset_f "ll"
253 #if FFETARGET_okINTEGER1
254 #ifdef FFETARGET_32bit_longs
255 typedef long int ffetargetInteger1
;
256 #define ffetargetInteger1_f "l"
258 typedef int ffetargetInteger1
;
259 #define ffetargetInteger1_f ""
262 #if FFETARGET_okINTEGER2
263 typedef signed char ffetargetInteger2
;
264 #define ffetargetInteger2_f ""
266 #if FFETARGET_okINTEGER3
267 typedef short int ffetargetInteger3
;
268 #define ffetargetInteger3_f ""
270 #if FFETARGET_okINTEGER4
271 typedef long long int ffetargetInteger4
;
272 #define ffetargetInteger4_f "ll"
274 #if FFETARGET_okINTEGER5
275 typedef ? ffetargetInteger5
;
276 #define ffetargetInteger5_f
279 #if FFETARGET_okINTEGER6
280 typedef ? ffetargetInteger6
;
281 #define ffetargetInteger6_f
284 #if FFETARGET_okINTEGER7
285 typedef ? ffetargetInteger7
;
286 #define ffetargetInteger7_f
289 #if FFETARGET_okINTEGER8
290 typedef ? ffetargetInteger8
;
291 #define ffetargetInteger8_f
294 #if FFETARGET_okLOGICAL1
295 #ifdef FFETARGET_32bit_longs
296 typedef long int ffetargetLogical1
;
297 #define ffetargetLogical1_f "l"
299 typedef int ffetargetLogical1
;
300 #define ffetargetLogical1_f ""
303 #if FFETARGET_okLOGICAL2
304 typedef signed char ffetargetLogical2
;
305 #define ffetargetLogical2_f ""
307 #if FFETARGET_okLOGICAL3
308 typedef short int ffetargetLogical3
;
309 #define ffetargetLogical3_f ""
311 #if FFETARGET_okLOGICAL4
312 typedef long long int ffetargetLogical4
;
313 #define ffetargetLogical4_f "ll"
315 #if FFETARGET_okLOGICAL5
316 typedef ? ffetargetLogical5
;
317 #define ffetargetLogical5_f
320 #if FFETARGET_okLOGICAL6
321 typedef ? ffetargetLogical6
;
322 #define ffetargetLogical6_f
325 #if FFETARGET_okLOGICAL7
326 typedef ? ffetargetLogical7
;
327 #define ffetargetLogical7_f
330 #if FFETARGET_okLOGICAL8
331 typedef ? ffetargetLogical8
;
332 #define ffetargetLogical8_f
335 #if FFETARGET_okREAL1
336 #ifdef REAL_ARITHMETIC
337 #ifdef FFETARGET_32bit_longs
338 typedef long int ffetargetReal1
;
339 #define ffetargetReal1_f "l"
340 #define ffetarget_cvt_r1_to_rv_ REAL_VALUE_UNTO_TARGET_SINGLE
341 #define ffetarget_cvt_rv_to_r1_ REAL_VALUE_TO_TARGET_SINGLE
343 typedef int ffetargetReal1
;
344 #define ffetargetReal1_f ""
345 #define ffetarget_cvt_r1_to_rv_(in) \
346 ({ REAL_VALUE_TYPE _rv; \
347 _rv = REAL_VALUE_UNTO_TARGET_SINGLE ((long) (in)); \
349 #define ffetarget_cvt_rv_to_r1_(in, out) \
351 REAL_VALUE_TO_TARGET_SINGLE ((in), _tmp); \
352 (out) = (ffetargetReal1) _tmp; })
354 #else /* REAL_ARITHMETIC */
355 typedef float ffetargetReal1
;
356 #define ffetargetReal1_f ""
357 #endif /* REAL_ARITHMETIC */
359 #if FFETARGET_okREAL2
360 #ifdef REAL_ARITHMETIC
361 #ifdef FFETARGET_32bit_longs
367 #define ffetargetReal2_f "l"
368 #define ffetarget_cvt_r2_to_rv_ REAL_VALUE_UNTO_TARGET_DOUBLE
369 #define ffetarget_cvt_rv_to_r2_ REAL_VALUE_TO_TARGET_DOUBLE
376 #define ffetargetReal2_f ""
377 #define ffetarget_cvt_r2_to_rv_(in) \
378 ({ REAL_VALUE_TYPE _rv; \
382 _rv = REAL_VALUE_UNTO_TARGET_DOUBLE (_tmp); \
384 #define ffetarget_cvt_rv_to_r2_(in, out) \
386 REAL_VALUE_TO_TARGET_DOUBLE ((in), _tmp); \
387 (out)[0] = (int) (_tmp[0]); \
388 (out)[1] = (int) (_tmp[1]); })
391 typedef double ffetargetReal2
;
392 #define ffetargetReal2_f ""
395 #if FFETARGET_okREAL3
396 #ifdef REAL_ARITHMETIC
397 typedef long ffetargetReal3
[?];
399 typedef ? ffetargetReal3
;
400 #define ffetargetReal3_f
404 #if FFETARGET_okREAL4
405 #ifdef REAL_ARITHMETIC
406 typedef long ffetargetReal4
[?];
408 typedef ? ffetargetReal4
;
409 #define ffetargetReal4_f
413 #if FFETARGET_okREAL5
414 #ifdef REAL_ARITHMETIC
415 typedef long ffetargetReal5
[?];
417 typedef ? ffetargetReal5
;
418 #define ffetargetReal5_f
422 #if FFETARGET_okREAL6
423 #ifdef REAL_ARITHMETIC
424 typedef long ffetargetReal6
[?];
426 typedef ? ffetargetReal6
;
427 #define ffetargetReal6_f
431 #if FFETARGET_okREAL7
432 #ifdef REAL_ARITHMETIC
433 typedef long ffetargetReal7
[?];
435 typedef ? ffetargetReal7
;
436 #define ffetargetReal7_f
440 #if FFETARGET_okREAL8
441 #ifdef REAL_ARITHMETIC
442 typedef long ffetargetReal8
[?];
444 typedef ? ffetargetReal8
;
445 #define ffetargetReal8_f
449 #if FFETARGET_okCOMPLEX1
450 struct _ffetarget_complex_1_
453 ffetargetReal1 imaginary
;
455 typedef struct _ffetarget_complex_1_ ffetargetComplex1
;
457 #if FFETARGET_okCOMPLEX2
458 struct _ffetarget_complex_2_
461 ffetargetReal2 imaginary
;
463 typedef struct _ffetarget_complex_2_ ffetargetComplex2
;
465 #if FFETARGET_okCOMPLEX3
466 struct _ffetarget_complex_3_
469 ffetargetReal3 imaginary
;
471 typedef struct _ffetarget_complex_3_ ffetargetComplex3
;
473 #if FFETARGET_okCOMPLEX4
474 struct _ffetarget_complex_4_
477 ffetargetReal4 imaginary
;
479 typedef struct _ffetarget_complex_4_ ffetargetComplex4
;
481 #if FFETARGET_okCOMPLEX5
482 struct _ffetarget_complex_5_
485 ffetargetReal5 imaginary
;
487 typedef struct _ffetarget_complex_5_ ffetargetComplex5
;
489 #if FFETARGET_okCOMPLEX6
490 struct _ffetarget_complex_6_
493 ffetargetReal6 imaginary
;
495 typedef struct _ffetarget_complex_6_ ffetargetComplex6
;
497 #if FFETARGET_okCOMPLEX7
498 struct _ffetarget_complex_7_
501 ffetargetReal7 imaginary
;
503 typedef struct _ffetarget_complex_7_ ffetargetComplex7
;
505 #if FFETARGET_okCOMPLEX8
506 struct _ffetarget_complex_8_
509 ffetargetReal8 imaginary
;
511 typedef struct _ffetarget_complex_8_ ffetargetComplex8
;
513 #if FFETARGET_okCHARACTER1
514 struct _ffetarget_char_1_
516 ffetargetCharacterSize length
;
519 typedef struct _ffetarget_char_1_ ffetargetCharacter1
;
520 typedef unsigned char ffetargetCharacterUnit1
;
522 #if FFETARGET_okCHARACTER2
523 typedef ? ffetargetCharacter2
;
524 typedef ? ffetargetCharacterUnit2
;
526 #if FFETARGET_okCHARACTER3
527 typedef ? ffetargetCharacter3
;
528 typedef ? ffetargetCharacterUnit3
;
530 #if FFETARGET_okCHARACTER4
531 typedef ? ffetargetCharacter4
;
532 typedef ? ffetargetCharacterUnit4
;
534 #if FFETARGET_okCHARACTER5
535 typedef ? ffetargetCharacter5
;
536 typedef ? ffetargetCharacterUnit5
;
538 #if FFETARGET_okCHARACTER6
539 typedef ? ffetargetCharacter6
;
540 typedef ? ffetargetCharacterUnit6
;
542 #if FFETARGET_okCHARACTER7
543 typedef ? ffetargetCharacter7
;
544 typedef ? ffetargetCharacterUnit7
;
546 #if FFETARGET_okCHARACTER8
547 typedef ? ffetargetCharacter8
;
548 typedef ? ffetargetCharacterUnit8
;
551 typedef unsigned long long int ffetargetTypeless
;
553 struct _ffetarget_hollerith_
555 ffetargetHollerithSize length
;
558 typedef struct _ffetarget_hollerith_ ffetargetHollerith
;
560 typedef ffetargetCharacter1 ffetargetCharacterDefault
;
561 typedef ffetargetComplex1 ffetargetComplexDefault
;
562 #if FFETARGET_okCOMPLEXDOUBLE
563 typedef ffetargetComplex2 ffetargetComplexDouble
;
565 #if FFETARGET_okCOMPLEXQUAD
566 typedef ffetargetComplex3 ffetargetComplexQuad
;
568 typedef ffetargetInteger1 ffetargetIntegerDefault
;
569 #define ffetargetIntegerDefault_f ffetargetInteger1_f
570 typedef ffetargetLogical1 ffetargetLogicalDefault
;
571 #define ffetargetLogicalDefault_f ffetargetLogical1_f
572 typedef ffetargetReal1 ffetargetRealDefault
;
573 #define ffetargetRealDefault_f ffetargetReal1_f
574 typedef ffetargetReal2 ffetargetRealDouble
;
575 #define ffetargetRealDouble_f ffetargetReal2_f
576 #if FFETARGET_okREALQUAD
577 typedef ffetargetReal3 ffetargetRealQuad
;
578 #define ffetargetRealQuad_f ffetargetReal3_f
581 /* Include files needed by this one. */
588 /* Structure definitions. */
591 /* Global objects accessed by users of this module. */
593 extern char ffetarget_string_
[40]; /* Temp for ascii-to-double (atof). */
594 extern HOST_WIDE_INT ffetarget_long_val_
;
595 extern HOST_WIDE_INT ffetarget_long_junk_
;
597 /* Declare functions with prototypes. */
599 void ffetarget_aggregate_info (ffeinfoBasictype
*ebt
, ffeinfoKindtype
*ekt
,
600 ffetargetAlign
*units
, ffeinfoBasictype abt
,
601 ffeinfoKindtype akt
);
602 ffetargetAlign
ffetarget_align (ffetargetAlign
*updated_alignment
,
603 ffetargetAlign
*updated_modulo
,
604 ffetargetOffset offset
,
605 ffetargetAlign alignment
,
606 ffetargetAlign modulo
);
607 #if FFETARGET_okCHARACTER1
608 bool ffetarget_character1 (ffetargetCharacter1
*val
, ffelexToken character
,
610 int ffetarget_cmp_character1 (ffetargetCharacter1 l
, ffetargetCharacter1 r
);
611 ffebad
ffetarget_concatenate_character1 (ffetargetCharacter1
*res
,
612 ffetargetCharacter1 l
,
613 ffetargetCharacter1 r
,
615 ffetargetCharacterSize
*len
);
616 ffebad
ffetarget_convert_character1_character1 (ffetargetCharacter1
*res
,
617 ffetargetCharacterSize res_size
,
618 ffetargetCharacter1 l
,
620 ffebad
ffetarget_convert_character1_hollerith (ffetargetCharacter1
*res
,
621 ffetargetCharacterSize res_size
,
622 ffetargetHollerith l
,
624 ffebad
ffetarget_convert_character1_integer4 (ffetargetCharacter1
*res
,
625 ffetargetCharacterSize res_size
,
628 ffebad
ffetarget_convert_character1_logical4 (ffetargetCharacter1
*res
,
629 ffetargetCharacterSize res_size
,
632 ffebad
ffetarget_convert_character1_typeless (ffetargetCharacter1
*res
,
633 ffetargetCharacterSize res_size
,
636 ffebad
ffetarget_eq_character1 (bool *res
, ffetargetCharacter1 l
,
637 ffetargetCharacter1 r
);
638 ffebad
ffetarget_le_character1 (bool *res
, ffetargetCharacter1 l
,
639 ffetargetCharacter1 r
);
640 ffebad
ffetarget_ge_character1 (bool *res
, ffetargetCharacter1 l
,
641 ffetargetCharacter1 r
);
642 ffebad
ffetarget_gt_character1 (bool *res
, ffetargetCharacter1 l
,
643 ffetargetCharacter1 r
);
644 ffebad
ffetarget_lt_character1 (bool *res
, ffetargetCharacter1 l
,
645 ffetargetCharacter1 r
);
646 ffebad
ffetarget_ne_character1 (bool *res
, ffetargetCharacter1 l
,
647 ffetargetCharacter1 r
);
648 ffebad
ffetarget_substr_character1 (ffetargetCharacter1
*res
,
649 ffetargetCharacter1 l
,
650 ffetargetCharacterSize first
,
651 ffetargetCharacterSize last
,
653 ffetargetCharacterSize
*len
);
655 int ffetarget_cmp_hollerith (ffetargetHollerith l
, ffetargetHollerith r
);
656 bool ffetarget_hollerith (ffetargetHollerith
*val
, ffelexToken hollerith
,
658 int ffetarget_cmp_typeless (ffetargetTypeless l
, ffetargetTypeless r
);
659 ffebad
ffetarget_convert_any_character1_ (char *res
, size_t size
,
660 ffetargetCharacter1 l
);
661 ffebad
ffetarget_convert_any_hollerith_ (char *res
, size_t size
,
662 ffetargetHollerith l
);
663 ffebad
ffetarget_convert_any_typeless_ (char *res
, size_t size
,
664 ffetargetTypeless l
);
665 #if FFETARGET_okCOMPLEX1
666 ffebad
ffetarget_divide_complex1 (ffetargetComplex1
*res
, ffetargetComplex1 l
,
667 ffetargetComplex1 r
);
669 #if FFETARGET_okCOMPLEX2
670 ffebad
ffetarget_divide_complex2 (ffetargetComplex2
*res
, ffetargetComplex2 l
,
671 ffetargetComplex2 r
);
673 #if FFETARGET_okCOMPLEX3
674 ffebad
ffetarget_divide_complex3 (ffetargetComplex3
*res
, ffetargetComplex3 l
,
675 ffetargetComplex3 r
);
677 #if FFETARGET_okCOMPLEX4
678 ffebad
ffetarget_divide_complex4 (ffetargetComplex4
*res
, ffetargetComplex4 l
,
679 ffetargetComplex4 r
);
681 #if FFETARGET_okCOMPLEX5
682 ffebad
ffetarget_divide_complex5 (ffetargetComplex5
*res
, ffetargetComplex5 l
,
683 ffetargetComplex5 r
);
685 #if FFETARGET_okCOMPLEX6
686 ffebad
ffetarget_divide_complex6 (ffetargetComplex6
*res
, ffetargetComplex6 l
,
687 ffetargetComplex6 r
);
689 #if FFETARGET_okCOMPLEX7
690 ffebad
ffetarget_divide_complex7 (ffetargetComplex7
*res
, ffetargetComplex7 l
,
691 ffetargetComplex7 r
);
693 #if FFETARGET_okCOMPLEX8
694 ffebad
ffetarget_divide_complex8 (ffetargetComplex8
*res
, ffetargetComplex8 l
,
695 ffetargetComplex8 r
);
697 #if FFETARGET_okINTEGER1
698 bool ffetarget_integer1 (ffetargetInteger1
*val
, ffelexToken integer
);
700 #if FFETARGET_okINTEGER2
701 bool ffetarget_integer2 (ffetargetInteger2
*val
, ffelexToken integer
);
703 #if FFETARGET_okINTEGER3
704 bool ffetarget_integer3 (ffetargetInteger3
*val
, ffelexToken integer
);
706 #if FFETARGET_okINTEGER4
707 bool ffetarget_integer4 (ffetargetInteger4
*val
, ffelexToken integer
);
709 #if FFETARGET_okINTEGER5
710 bool ffetarget_integer5 (ffetargetInteger5
*val
, ffelexToken integer
);
712 #if FFETARGET_okINTEGER6
713 bool ffetarget_integer6 (ffetargetInteger6
*val
, ffelexToken integer
);
715 #if FFETARGET_okINTEGER7
716 bool ffetarget_integer7 (ffetargetInteger7
*val
, ffelexToken integer
);
718 #if FFETARGET_okINTEGER8
719 bool ffetarget_integer8 (ffetargetInteger8
*val
, ffelexToken integer
);
721 bool ffetarget_integerbinary (ffetargetIntegerDefault
*val
,
722 ffelexToken integer
);
723 bool ffetarget_integerhex (ffetargetIntegerDefault
*val
,
724 ffelexToken integer
);
725 bool ffetarget_integeroctal (ffetargetIntegerDefault
*val
,
726 ffelexToken integer
);
727 void ffetarget_integer_bad_magical (ffelexToken t
);
728 void ffetarget_integer_bad_magical_binary (ffelexToken integer
, ffelexToken minus
);
729 void ffetarget_integer_bad_magical_precedence (ffelexToken integer
,
731 ffelexToken higher_op
);
732 void ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer
,
734 ffelexToken higher_op
);
735 #if FFETARGET_okCHARACTER1
736 bool ffetarget_iszero_character1 (ffetargetCharacter1 constant
);
738 bool ffetarget_iszero_hollerith (ffetargetHollerith constant
);
739 void ffetarget_layout (const char *error_text
, ffetargetAlign
*alignment
,
740 ffetargetAlign
*modulo
, ffetargetOffset
*size
,
741 ffeinfoBasictype bt
, ffeinfoKindtype kt
,
742 ffetargetCharacterSize charsize
,
743 ffetargetIntegerDefault num_elements
);
744 #if FFETARGET_okCOMPLEX1
745 ffebad
ffetarget_multiply_complex1 (ffetargetComplex1
*res
,
747 ffetargetComplex1 r
);
749 #if FFETARGET_okCOMPLEX2
750 ffebad
ffetarget_multiply_complex2 (ffetargetComplex2
*res
,
752 ffetargetComplex2 r
);
754 #if FFETARGET_okCOMPLEX3
755 ffebad
ffetarget_multiply_complex3 (ffetargetComplex3
*res
,
757 ffetargetComplex3 r
);
759 #if FFETARGET_okCOMPLEX4
760 ffebad
ffetarget_multiply_complex4 (ffetargetComplex4
*res
,
762 ffetargetComplex4 r
);
764 #if FFETARGET_okCOMPLEX5
765 ffebad
ffetarget_multiply_complex5 (ffetargetComplex5
*res
,
767 ffetargetComplex5 r
);
769 #if FFETARGET_okCOMPLEX6
770 ffebad
ffetarget_multiply_complex6 (ffetargetComplex6
*res
,
772 ffetargetComplex6 r
);
774 #if FFETARGET_okCOMPLEX7
775 ffebad
ffetarget_multiply_complex7 (ffetargetComplex7
*res
,
777 ffetargetComplex7 r
);
779 #if FFETARGET_okCOMPLEX8
780 ffebad
ffetarget_multiply_complex8 (ffetargetComplex8
*res
,
782 ffetargetComplex8 r
);
784 ffebad
ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault
*res
,
785 ffetargetComplexDefault l
,
786 ffetargetIntegerDefault r
);
787 #if FFETARGET_okCOMPLEXDOUBLE
788 ffebad
ffetarget_power_complexdouble_integerdefault (ffetargetComplexDouble
*res
,
789 ffetargetComplexDouble l
,
790 ffetargetIntegerDefault r
);
792 ffebad
ffetarget_power_integerdefault_integerdefault (ffetargetIntegerDefault
*res
,
793 ffetargetIntegerDefault l
,
794 ffetargetIntegerDefault r
);
795 ffebad
ffetarget_power_realdefault_integerdefault (ffetargetRealDefault
*res
,
796 ffetargetRealDefault l
,
797 ffetargetIntegerDefault r
);
798 ffebad
ffetarget_power_realdouble_integerdefault (ffetargetRealDouble
*res
,
799 ffetargetRealDouble l
,
800 ffetargetIntegerDefault r
);
801 void ffetarget_print_binary (FILE *f
, ffetargetTypeless val
);
802 void ffetarget_print_character1 (FILE *f
, ffetargetCharacter1 val
);
803 void ffetarget_print_hollerith (FILE *f
, ffetargetHollerith val
);
804 void ffetarget_print_octal (FILE *f
, ffetargetTypeless val
);
805 void ffetarget_print_hex (FILE *f
, ffetargetTypeless val
);
806 #if FFETARGET_okREAL1
807 bool ffetarget_real1 (ffetargetReal1
*value
, ffelexToken integer
,
808 ffelexToken decimal
, ffelexToken fraction
,
809 ffelexToken exponent
, ffelexToken exponent_sign
,
810 ffelexToken exponent_digits
);
812 #if FFETARGET_okREAL2
813 bool ffetarget_real2 (ffetargetReal2
*value
, ffelexToken integer
,
814 ffelexToken decimal
, ffelexToken fraction
,
815 ffelexToken exponent
, ffelexToken exponent_sign
,
816 ffelexToken exponent_digits
);
818 #if FFETARGET_okREAL3
819 bool ffetarget_real3 (ffetargetReal3
*value
, ffelexToken integer
,
820 ffelexToken decimal
, ffelexToken fraction
,
821 ffelexToken exponent
, ffelexToken exponent_sign
,
822 ffelexToken exponent_digits
);
824 #if FFETARGET_okREAL4
825 bool ffetarget_real4 (ffetargetReal4
*value
, ffelexToken integer
,
826 ffelexToken decimal
, ffelexToken fraction
,
827 ffelexToken exponent
, ffelexToken exponent_sign
,
828 ffelexToken exponent_digits
);
830 #if FFETARGET_okREAL5
831 bool ffetarget_real5 (ffetargetReal5
*value
, ffelexToken integer
,
832 ffelexToken decimal
, ffelexToken fraction
,
833 ffelexToken exponent
, ffelexToken exponent_sign
,
834 ffelexToken exponent_digits
);
836 #if FFETARGET_okREAL6
837 bool ffetarget_real6 (ffetargetReal6
*value
, ffelexToken integer
,
838 ffelexToken decimal
, ffelexToken fraction
,
839 ffelexToken exponent
, ffelexToken exponent_sign
,
840 ffelexToken exponent_digits
);
842 #if FFETARGET_okREAL7
843 bool ffetarget_real7 (ffetargetReal7
*value
, ffelexToken integer
,
844 ffelexToken decimal
, ffelexToken fraction
,
845 ffelexToken exponent
, ffelexToken exponent_sign
,
846 ffelexToken exponent_digits
);
848 #if FFETARGET_okREAL8
849 bool ffetarget_real8 (ffetargetReal8
*value
, ffelexToken integer
,
850 ffelexToken decimal
, ffelexToken fraction
,
851 ffelexToken exponent
, ffelexToken exponent_sign
,
852 ffelexToken exponent_digits
);
854 bool ffetarget_typeless_binary (ffetargetTypeless
*value
, ffelexToken token
);
855 bool ffetarget_typeless_octal (ffetargetTypeless
*value
, ffelexToken token
);
856 bool ffetarget_typeless_hex (ffetargetTypeless
*value
, ffelexToken token
);
857 void ffetarget_verify_character1 (mallocPool pool
, ffetargetCharacter1 val
);
858 int ffetarget_num_digits_ (ffelexToken t
);
859 void *ffetarget_memcpy_ (void *dst
, void *src
, size_t len
);
864 #define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
865 REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), ((kt == 1) ? SFmode : DFmode))
867 #define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
868 REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0))
871 #ifdef REAL_ARITHMETIC
872 #define ffetarget_add_complex1(res,l,r) \
873 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
874 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
875 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
876 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
877 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
878 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
879 REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
880 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
881 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
883 #define ffetarget_add_complex2(res,l,r) \
884 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
885 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
886 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
887 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
888 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
889 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
890 REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
891 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
892 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
895 #define ffetarget_add_complex1(res,l,r) \
896 ((res)->real = (l).real + (r).real, \
897 (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
898 #define ffetarget_add_complex2(res,l,r) \
899 ((res)->real = (l).real + (r).real, \
900 (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
902 #define ffetarget_add_integer1(res,l,r) (*(res) = (l) + (r), FFEBAD)
903 #define ffetarget_add_integer2(res,l,r) (*(res) = (l) + (r), FFEBAD)
904 #define ffetarget_add_integer3(res,l,r) (*(res) = (l) + (r), FFEBAD)
905 #define ffetarget_add_integer4(res,l,r) (*(res) = (l) + (r), FFEBAD)
906 #ifdef REAL_ARITHMETIC
907 #define ffetarget_add_real1(res,l,r) \
908 ({ REAL_VALUE_TYPE lr, rr, resr; \
909 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
910 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
911 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
912 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
914 #define ffetarget_add_real2(res,l,r) \
915 ({ REAL_VALUE_TYPE lr, rr, resr; \
916 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
917 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
918 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
919 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
922 #define ffetarget_add_real1(res,l,r) (*(res) = (l) + (r), FFEBAD)
923 #define ffetarget_add_real2(res,l,r) (*(res) = (l) + (r), FFEBAD)
925 #define ffetarget_aggregate_ptr_memcpy(dbt,dkt,sbt,skt) \
926 ((ffetargetCopyfunc) ffetarget_memcpy_)
927 #define ffetarget_and_integer1(res,l,r) (*(res) = (l) & (r), FFEBAD)
928 #define ffetarget_and_integer2(res,l,r) (*(res) = (l) & (r), FFEBAD)
929 #define ffetarget_and_integer3(res,l,r) (*(res) = (l) & (r), FFEBAD)
930 #define ffetarget_and_integer4(res,l,r) (*(res) = (l) & (r), FFEBAD)
931 #define ffetarget_and_logical1(res,l,r) (*(res) = (l) && (r), FFEBAD)
932 #define ffetarget_and_logical2(res,l,r) (*(res) = (l) && (r), FFEBAD)
933 #define ffetarget_and_logical3(res,l,r) (*(res) = (l) && (r), FFEBAD)
934 #define ffetarget_and_logical4(res,l,r) (*(res) = (l) && (r), FFEBAD)
935 #define ffetarget_binarymil(v,t) ffetarget_typeless_binary (v, t)
936 #define ffetarget_binaryvxt(v,t) ffetarget_typeless_binary (v, t)
937 #define ffetarget_cmp_integer1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
938 #define ffetarget_cmp_integer2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
939 #define ffetarget_cmp_integer3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
940 #define ffetarget_cmp_integer4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
941 #define ffetarget_cmp_logical1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
942 #define ffetarget_cmp_logical2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
943 #define ffetarget_cmp_logical3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
944 #define ffetarget_cmp_logical4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
945 #define ffetarget_cmp_real1(l,r) memcmp (&(l), &(r), sizeof(l))
946 #define ffetarget_cmp_real2(l,r) memcmp (&(l), &(r), sizeof(l))
947 #define ffetarget_cmp_real3(l,r) memcmp (&(l), &(r), sizeof(l))
948 #define ffetarget_cmp_typeless(l,r) \
949 memcmp (&(l), &(r), sizeof ((l)))
950 #define ffetarget_convert_character1_integer1(res,res_size,l,pool) \
951 ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
952 #define ffetarget_convert_character1_integer2(res,res_size,l,pool) \
953 ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
954 #define ffetarget_convert_character1_integer3(res,res_size,l,pool) \
955 ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
956 #define ffetarget_convert_character1_logical1(res,res_size,l,pool) \
957 ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
958 #define ffetarget_convert_character1_logical2(res,res_size,l,pool) \
959 ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
960 #define ffetarget_convert_character1_logical3(res,res_size,l,pool) \
961 ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
962 #define ffetarget_convert_complex1_character1(res,l) \
963 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
964 #define ffetarget_convert_complex1_hollerith(res,l) \
965 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
966 #define ffetarget_convert_complex1_typeless(res,l) \
967 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
968 #ifdef REAL_ARITHMETIC
969 #define ffetarget_convert_complex1_complex2(res,l) \
970 ({ REAL_VALUE_TYPE lr, li; \
971 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
972 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
973 ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
974 ffetarget_cvt_rv_to_r1_ (li, (res)->imaginary), \
977 #define ffetarget_convert_complex1_complex2(res,l) \
978 ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
980 #ifdef REAL_ARITHMETIC
981 #define ffetarget_convert_complex1_integer(res,l) \
982 ({ REAL_VALUE_TYPE resi, resr; \
983 ffetargetInteger1 lf = (l); \
984 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
986 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
987 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
990 #define ffetarget_convert_complex1_integer(res,l) \
991 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
993 #define ffetarget_convert_complex1_integer1 ffetarget_convert_complex1_integer
994 #define ffetarget_convert_complex1_integer2 ffetarget_convert_complex1_integer
995 #define ffetarget_convert_complex1_integer3 ffetarget_convert_complex1_integer
996 #ifdef REAL_ARITHMETIC
997 #define ffetarget_convert_complex1_integer4(res,l) FFEBAD_NOCANDO
999 #define ffetarget_convert_complex1_integer4 ffetarget_convert_complex1_integer
1001 #ifdef REAL_ARITHMETIC
1002 #define ffetarget_convert_complex1_real1(res,l) \
1003 ((res)->real = (l), \
1004 ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
1006 #define ffetarget_convert_complex1_real2(res,l) \
1007 ({ REAL_VALUE_TYPE lr; \
1008 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1009 ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
1010 ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
1013 #define ffetarget_convert_complex1_real1(res,l) \
1014 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1015 #define ffetarget_convert_complex1_real2(res,l) \
1016 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1018 #define ffetarget_convert_complex2_character1(res,l) \
1019 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1020 #define ffetarget_convert_complex2_hollerith(res,l) \
1021 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1022 #define ffetarget_convert_complex2_typeless(res,l) \
1023 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1024 #ifdef REAL_ARITHMETIC
1025 #define ffetarget_convert_complex2_complex1(res,l) \
1026 ({ REAL_VALUE_TYPE lr, li; \
1027 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1028 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1029 ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
1030 ffetarget_cvt_rv_to_r2_ (li, &((res)->imaginary.v[0])), \
1033 #define ffetarget_convert_complex2_complex1(res,l) \
1034 ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
1036 #ifdef REAL_ARITHMETIC
1037 #define ffetarget_convert_complex2_integer(res,l) \
1038 ({ REAL_VALUE_TYPE resi, resr; \
1039 ffetargetInteger1 lf = (l); \
1040 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
1042 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1043 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1046 #define ffetarget_convert_complex2_integer(res,l) \
1047 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1049 #define ffetarget_convert_complex2_integer1 ffetarget_convert_complex2_integer
1050 #define ffetarget_convert_complex2_integer2 ffetarget_convert_complex2_integer
1051 #define ffetarget_convert_complex2_integer3 ffetarget_convert_complex2_integer
1052 #ifdef REAL_ARITHMETIC
1053 #define ffetarget_convert_complex2_integer4(res,l) FFEBAD_NOCANDO
1055 #define ffetarget_convert_complex2_integer4 ffetarget_convert_complex2_integer
1057 #ifdef REAL_ARITHMETIC
1058 #define ffetarget_convert_complex2_real1(res,l) \
1059 ({ REAL_VALUE_TYPE lr; \
1060 lr = ffetarget_cvt_r1_to_rv_ (l); \
1061 ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
1062 ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
1064 #define ffetarget_convert_complex2_real2(res,l) \
1065 ((res)->real = (l), \
1066 ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
1069 #define ffetarget_convert_complex2_real1(res,l) \
1070 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1071 #define ffetarget_convert_complex2_real2(res,l) \
1072 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1074 #define ffetarget_convert_integer2_character1(res,l) \
1075 ffetarget_convert_integer1_character1(res,l)
1076 #define ffetarget_convert_integer2_complex1(res,l) \
1077 ffetarget_convert_integer1_complex1(res,l)
1078 #define ffetarget_convert_integer2_complex2(res,l) \
1079 ffetarget_convert_integer1_complex2(res,l)
1080 #define ffetarget_convert_integer2_hollerith(res,l) \
1081 ffetarget_convert_integer1_hollerith(res,l)
1082 #define ffetarget_convert_integer2_integer1(res,l) (*(res) = (l), FFEBAD)
1083 #define ffetarget_convert_integer2_integer3(res,l) (*(res) = (l), FFEBAD)
1084 #define ffetarget_convert_integer2_integer4(res,l) (*(res) = (l), FFEBAD)
1085 #define ffetarget_convert_integer2_logical1(res,l) \
1086 ffetarget_convert_integer1_logical1(res,l)
1087 #define ffetarget_convert_integer2_logical2(res,l) \
1088 ffetarget_convert_integer2_logical1(res,l)
1089 #define ffetarget_convert_integer2_logical3(res,l) \
1090 ffetarget_convert_integer2_logical1(res,l)
1091 #define ffetarget_convert_integer2_logical4(res,l) \
1092 ffetarget_convert_integer2_logical1(res,l)
1093 #define ffetarget_convert_integer2_real1(res,l) \
1094 ffetarget_convert_integer1_real1(res,l)
1095 #define ffetarget_convert_integer2_real2(res,l) \
1096 ffetarget_convert_integer1_real2(res,l)
1097 #define ffetarget_convert_integer2_typeless(res,l) \
1098 ffetarget_convert_integer1_typeless(res,l)
1099 #define ffetarget_convert_integer3_character1(res,l) \
1100 ffetarget_convert_integer1_character1(res,l)
1101 #define ffetarget_convert_integer3_complex1(res,l) \
1102 ffetarget_convert_integer1_complex1(res,l)
1103 #define ffetarget_convert_integer3_complex2(res,l) \
1104 ffetarget_convert_integer1_complex2(res,l)
1105 #define ffetarget_convert_integer3_hollerith(res,l) \
1106 ffetarget_convert_integer1_hollerith(res,l)
1107 #define ffetarget_convert_integer3_integer1(res,l) (*(res) = (l), FFEBAD)
1108 #define ffetarget_convert_integer3_integer2(res,l) (*(res) = (l), FFEBAD)
1109 #define ffetarget_convert_integer3_integer4(res,l) (*(res) = (l), FFEBAD)
1110 #define ffetarget_convert_integer3_logical1(res,l) \
1111 ffetarget_convert_integer1_logical1(res,l)
1112 #define ffetarget_convert_integer3_logical2(res,l) \
1113 ffetarget_convert_integer3_logical1(res,l)
1114 #define ffetarget_convert_integer3_logical3(res,l) \
1115 ffetarget_convert_integer3_logical1(res,l)
1116 #define ffetarget_convert_integer3_logical4(res,l) \
1117 ffetarget_convert_integer3_logical1(res,l)
1118 #define ffetarget_convert_integer3_real1(res,l) \
1119 ffetarget_convert_integer1_real1(res,l)
1120 #define ffetarget_convert_integer3_real2(res,l) \
1121 ffetarget_convert_integer1_real2(res,l)
1122 #define ffetarget_convert_integer3_typeless(res,l) \
1123 ffetarget_convert_integer1_typeless(res,l)
1124 #define ffetarget_convert_integer4_character1(res,l) \
1125 ffetarget_convert_integer1_character1(res,l)
1126 #ifdef REAL_ARITHMETIC
1127 #define ffetarget_convert_integer4_complex1(res,l) FFEBAD_NOCANDO
1128 #define ffetarget_convert_integer4_complex2(res,l) FFEBAD_NOCANDO
1130 #define ffetarget_convert_integer4_complex1(res,l) \
1131 ffetarget_convert_integer1_complex1(res,l)
1132 #define ffetarget_convert_integer4_complex2(res,l) \
1133 ffetarget_convert_integer1_complex2(res,l)
1135 #define ffetarget_convert_integer4_hollerith(res,l) \
1136 ffetarget_convert_integer1_hollerith(res,l)
1137 #define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD)
1138 #define ffetarget_convert_integer4_integer2(res,l) (*(res) = (l), FFEBAD)
1139 #define ffetarget_convert_integer4_integer3(res,l) (*(res) = (l), FFEBAD)
1140 #define ffetarget_convert_integer4_logical1(res,l) \
1141 ffetarget_convert_integer1_logical1(res,l)
1142 #define ffetarget_convert_integer4_logical2(res,l) \
1143 ffetarget_convert_integer1_logical1(res,l)
1144 #define ffetarget_convert_integer4_logical3(res,l) \
1145 ffetarget_convert_integer1_logical1(res,l)
1146 #define ffetarget_convert_integer4_logical4(res,l) \
1147 ffetarget_convert_integer1_logical1(res,l)
1148 #ifdef REAL_ARITHMETIC
1149 #define ffetarget_convert_integer4_real1(res,l) FFEBAD_NOCANDO
1150 #define ffetarget_convert_integer4_real2(res,l) FFEBAD_NOCANDO
1152 #define ffetarget_convert_integer4_real1(res,l) \
1153 ffetarget_convert_integer1_real1(res,l)
1154 #define ffetarget_convert_integer4_real2(res,l) \
1155 ffetarget_convert_integer1_real2(res,l)
1157 #define ffetarget_convert_integer4_typeless(res,l) \
1158 ffetarget_convert_integer1_typeless(res,l)
1159 #define ffetarget_convert_logical1_character1(res,l) \
1160 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1161 #define ffetarget_convert_logical1_hollerith(res,l) \
1162 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1163 #define ffetarget_convert_logical1_typeless(res,l) \
1164 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1165 #define ffetarget_convert_logical1_logical2(res,l) (*(res) = (l), FFEBAD)
1166 #define ffetarget_convert_logical1_logical3(res,l) (*(res) = (l), FFEBAD)
1167 #define ffetarget_convert_logical1_logical4(res,l) (*(res) = (l), FFEBAD)
1168 #define ffetarget_convert_logical1_integer1(res,l) (*(res) = (l), FFEBAD)
1169 #define ffetarget_convert_logical1_integer2(res,l) (*(res) = (l), FFEBAD)
1170 #define ffetarget_convert_logical1_integer3(res,l) (*(res) = (l), FFEBAD)
1171 #define ffetarget_convert_logical1_integer4(res,l) (*(res) = (l), FFEBAD)
1172 #define ffetarget_convert_logical2_character1(res,l) \
1173 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1174 #define ffetarget_convert_logical2_hollerith(res,l) \
1175 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1176 #define ffetarget_convert_logical2_typeless(res,l) \
1177 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1178 #define ffetarget_convert_logical2_logical1(res,l) (*(res) = (l), FFEBAD)
1179 #define ffetarget_convert_logical2_logical3(res,l) (*(res) = (l), FFEBAD)
1180 #define ffetarget_convert_logical2_logical4(res,l) (*(res) = (l), FFEBAD)
1181 #define ffetarget_convert_logical2_integer1(res,l) (*(res) = (l), FFEBAD)
1182 #define ffetarget_convert_logical2_integer2(res,l) (*(res) = (l), FFEBAD)
1183 #define ffetarget_convert_logical2_integer3(res,l) (*(res) = (l), FFEBAD)
1184 #define ffetarget_convert_logical2_integer4(res,l) (*(res) = (l), FFEBAD)
1185 #define ffetarget_convert_logical3_character1(res,l) \
1186 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1187 #define ffetarget_convert_logical3_hollerith(res,l) \
1188 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1189 #define ffetarget_convert_logical3_typeless(res,l) \
1190 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1191 #define ffetarget_convert_logical3_logical1(res,l) (*(res) = (l), FFEBAD)
1192 #define ffetarget_convert_logical3_logical2(res,l) (*(res) = (l), FFEBAD)
1193 #define ffetarget_convert_logical3_logical4(res,l) (*(res) = (l), FFEBAD)
1194 #define ffetarget_convert_logical3_integer1(res,l) (*(res) = (l), FFEBAD)
1195 #define ffetarget_convert_logical3_integer2(res,l) (*(res) = (l), FFEBAD)
1196 #define ffetarget_convert_logical3_integer3(res,l) (*(res) = (l), FFEBAD)
1197 #define ffetarget_convert_logical3_integer4(res,l) (*(res) = (l), FFEBAD)
1198 #define ffetarget_convert_logical4_character1(res,l) \
1199 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1200 #define ffetarget_convert_logical4_hollerith(res,l) \
1201 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1202 #define ffetarget_convert_logical4_typeless(res,l) \
1203 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1204 #define ffetarget_convert_logical4_logical1(res,l) (*(res) = (l), FFEBAD)
1205 #define ffetarget_convert_logical4_logical2(res,l) (*(res) = (l), FFEBAD)
1206 #define ffetarget_convert_logical4_logical3(res,l) (*(res) = (l), FFEBAD)
1207 #define ffetarget_convert_logical4_integer1(res,l) (*(res) = (l), FFEBAD)
1208 #define ffetarget_convert_logical4_integer2(res,l) (*(res) = (l), FFEBAD)
1209 #define ffetarget_convert_logical4_integer3(res,l) (*(res) = (l), FFEBAD)
1210 #define ffetarget_convert_logical4_integer4(res,l) (*(res) = (l), FFEBAD)
1211 #define ffetarget_convert_integer1_character1(res,l) \
1212 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1213 #define ffetarget_convert_integer1_hollerith(res,l) \
1214 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1215 #define ffetarget_convert_integer1_typeless(res,l) \
1216 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1217 #define ffetarget_convert_integer1_integer2(res,l) (*(res) = (l), FFEBAD)
1218 #define ffetarget_convert_integer1_integer3(res,l) (*(res) = (l), FFEBAD)
1219 #define ffetarget_convert_integer1_integer4(res,l) (*(res) = (l), FFEBAD)
1220 #define ffetarget_convert_integer1_logical1(res,l) (*(res) = (l), FFEBAD)
1221 #define ffetarget_convert_integer1_logical2(res,l) (*(res) = (l), FFEBAD)
1222 #define ffetarget_convert_integer1_logical3(res,l) (*(res) = (l), FFEBAD)
1223 #define ffetarget_convert_integer1_logical4(res,l) (*(res) = (l), FFEBAD)
1224 #ifdef REAL_ARITHMETIC
1225 #define ffetarget_convert_integer1_real1(res,l) \
1226 ({ REAL_VALUE_TYPE lr; \
1227 lr = ffetarget_cvt_r1_to_rv_ (l); \
1228 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1229 *(res) = ffetarget_long_val_; \
1231 #define ffetarget_convert_integer1_real2(res,l) \
1232 ({ REAL_VALUE_TYPE lr; \
1233 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1234 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1235 *(res) = ffetarget_long_val_; \
1237 #define ffetarget_convert_integer1_complex1(res,l) \
1238 ({ REAL_VALUE_TYPE lr; \
1239 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1240 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1241 *(res) = ffetarget_long_val_; \
1243 #define ffetarget_convert_integer1_complex2(res,l) \
1244 ({ REAL_VALUE_TYPE lr; \
1245 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1246 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1247 *(res) = ffetarget_long_val_; \
1250 #define ffetarget_convert_integer1_real1(res,l) (*(res) = (l), FFEBAD)
1251 #define ffetarget_convert_integer1_real2(res,l) (*(res) = (l), FFEBAD)
1252 #define ffetarget_convert_integer1_complex1(res,l) (*(res) = (l).real, FFEBAD)
1253 #define ffetarget_convert_integer1_complex2(res,l) (*(res) = (l).real, FFEBAD)
1255 #define ffetarget_convert_real1_character1(res,l) \
1256 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1257 #define ffetarget_convert_real1_hollerith(res,l) \
1258 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1259 #define ffetarget_convert_real1_integer2(res,l) \
1260 ffetarget_convert_real1_integer1(res,l)
1261 #define ffetarget_convert_real1_integer3(res,l) \
1262 ffetarget_convert_real1_integer1(res,l)
1263 #ifdef REAL_ARITHMETIC
1264 #define ffetarget_convert_real1_integer4(res,l) FFEBAD_NOCANDO
1266 #define ffetarget_convert_real1_integer4(res,l) \
1267 ffetarget_convert_real1_integer1(res,l)
1269 #define ffetarget_convert_real1_typeless(res,l) \
1270 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1271 #define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD)
1272 #define ffetarget_convert_real1_complex2(res,l) \
1273 ffetarget_convert_real1_real2 ((res), (l).real)
1274 #ifdef REAL_ARITHMETIC
1275 #define ffetarget_convert_real1_integer1(res,l) \
1276 ({ REAL_VALUE_TYPE resr; \
1277 ffetargetInteger1 lf = (l); \
1278 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
1279 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1282 #define ffetarget_convert_real1_integer1(res,l) (*(res) = (l), FFEBAD)
1284 #ifdef REAL_ARITHMETIC
1285 #define ffetarget_convert_real1_real2(res,l) \
1286 ({ REAL_VALUE_TYPE lr; \
1287 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1288 ffetarget_cvt_rv_to_r1_ (lr, *(res)); \
1291 #define ffetarget_convert_real1_real2(res,l) (*(res) = (l), FFEBAD)
1293 #define ffetarget_convert_real2_character1(res,l) \
1294 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1295 #define ffetarget_convert_real2_hollerith(res,l) \
1296 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1297 #define ffetarget_convert_real2_integer2(res,l) \
1298 ffetarget_convert_real2_integer1(res,l)
1299 #define ffetarget_convert_real2_integer3(res,l) \
1300 ffetarget_convert_real2_integer1(res,l)
1301 #ifdef REAL_ARITHMETIC
1302 #define ffetarget_convert_real2_integer4(res,l) FFEBAD_NOCANDO
1304 #define ffetarget_convert_real2_integer4(res,l) \
1305 ffetarget_convert_real2_integer1(res,l)
1307 #define ffetarget_convert_real2_typeless(res,l) \
1308 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1309 #define ffetarget_convert_real2_complex1(res,l) \
1310 ffetarget_convert_real2_real1 ((res), (l).real)
1311 #define ffetarget_convert_real2_complex2(res,l) (*(res) = (l).real, FFEBAD)
1312 #ifdef REAL_ARITHMETIC
1313 #define ffetarget_convert_real2_integer(res,l) \
1314 ({ REAL_VALUE_TYPE resr; \
1315 ffetargetInteger1 lf = (l); \
1316 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
1317 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1319 #define ffetarget_convert_real2_integer1 ffetarget_convert_real2_integer
1321 #define ffetarget_convert_real2_integer1(res,l) (*(res) = (l), FFEBAD)
1323 #ifdef REAL_ARITHMETIC
1324 #define ffetarget_convert_real2_real1(res,l) \
1325 ({ REAL_VALUE_TYPE lr; \
1326 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1327 ffetarget_cvt_rv_to_r2_ (lr, &((res)->v[0])); \
1330 #define ffetarget_convert_real2_real1(res,l) (*(res) = (l), FFEBAD)
1332 #define ffetarget_divide_integer1(res,l,r) \
1333 (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
1334 : (*(res) = (l) / (r), FFEBAD))
1335 #define ffetarget_divide_integer2(res,l,r) \
1336 ffetarget_divide_integer1(res,l,r)
1337 #define ffetarget_divide_integer3(res,l,r) \
1338 ffetarget_divide_integer1(res,l,r)
1339 #define ffetarget_divide_integer4(res,l,r) \
1340 ffetarget_divide_integer1(res,l,r)
1341 #ifdef REAL_ARITHMETIC
1342 #define ffetarget_divide_real1(res,l,r) \
1343 ({ REAL_VALUE_TYPE lr, rr, resr; \
1344 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1345 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1346 REAL_VALUES_EQUAL (rr, dconst0) \
1347 ? ({ ffetarget_cvt_rv_to_r1_ (dconst0, *(res)); \
1348 FFEBAD_DIV_BY_ZERO; \
1350 : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
1351 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1355 #define ffetarget_divide_real2(res,l,r) \
1356 ({ REAL_VALUE_TYPE lr, rr, resr; \
1357 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1358 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1359 REAL_VALUES_EQUAL (rr, dconst0) \
1360 ? ({ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0])); \
1361 FFEBAD_DIV_BY_ZERO; \
1363 : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
1364 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1369 #define ffetarget_divide_real1(res,l,r) \
1370 (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
1371 : (*(res) = (l) / (r), FFEBAD))
1372 #define ffetarget_divide_real2(res,l,r) \
1373 (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
1374 : (*(res) = (l) / (r), FFEBAD))
1376 #ifdef REAL_ARITHMETIC
1377 #define ffetarget_eq_complex1(res,l,r) \
1378 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1379 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1380 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1381 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1382 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1383 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1386 #define ffetarget_eq_complex2(res,l,r) \
1387 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1388 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1389 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1390 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1391 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1392 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1396 #define ffetarget_eq_complex1(res,l,r) \
1397 (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \
1398 ? TRUE : FALSE, FFEBAD)
1399 #define ffetarget_eq_complex2(res,l,r) \
1400 (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \
1401 ? TRUE : FALSE, FFEBAD)
1403 #define ffetarget_eq_integer1(res,l,r) \
1404 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1405 #define ffetarget_eq_integer2(res,l,r) \
1406 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1407 #define ffetarget_eq_integer3(res,l,r) \
1408 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1409 #define ffetarget_eq_integer4(res,l,r) \
1410 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1411 #ifdef REAL_ARITHMETIC
1412 #define ffetarget_eq_real1(res,l,r) \
1413 ({ REAL_VALUE_TYPE lr, rr; \
1414 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1415 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1416 *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
1418 #define ffetarget_eq_real2(res,l,r) \
1419 ({ REAL_VALUE_TYPE lr, rr; \
1420 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1421 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1422 *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
1425 #define ffetarget_eq_real1(res,l,r) \
1426 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1427 #define ffetarget_eq_real2(res,l,r) \
1428 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1430 #define ffetarget_eqv_integer1(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1431 #define ffetarget_eqv_integer2(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1432 #define ffetarget_eqv_integer3(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1433 #define ffetarget_eqv_integer4(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1434 #define ffetarget_eqv_logical1(res,l,r) (*(res) = (l) == (r), FFEBAD)
1435 #define ffetarget_eqv_logical2(res,l,r) (*(res) = (l) == (r), FFEBAD)
1436 #define ffetarget_eqv_logical3(res,l,r) (*(res) = (l) == (r), FFEBAD)
1437 #define ffetarget_eqv_logical4(res,l,r) (*(res) = (l) == (r), FFEBAD)
1438 #define ffetarget_ge_integer1(res,l,r) \
1439 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1440 #define ffetarget_ge_integer2(res,l,r) \
1441 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1442 #define ffetarget_ge_integer3(res,l,r) \
1443 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1444 #define ffetarget_ge_integer4(res,l,r) \
1445 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1446 #ifdef REAL_ARITHMETIC
1447 #define ffetarget_ge_real1(res,l,r) \
1448 ({ REAL_VALUE_TYPE lr, rr; \
1449 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1450 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1451 *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
1453 #define ffetarget_ge_real2(res,l,r) \
1454 ({ REAL_VALUE_TYPE lr, rr; \
1455 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1456 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1457 *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
1460 #define ffetarget_ge_real1(res,l,r) \
1461 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1462 #define ffetarget_ge_real2(res,l,r) \
1463 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1465 #define ffetarget_gt_integer1(res,l,r) \
1466 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1467 #define ffetarget_gt_integer2(res,l,r) \
1468 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1469 #define ffetarget_gt_integer3(res,l,r) \
1470 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1471 #define ffetarget_gt_integer4(res,l,r) \
1472 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1473 #ifdef REAL_ARITHMETIC
1474 #define ffetarget_gt_real1(res,l,r) \
1475 ({ REAL_VALUE_TYPE lr, rr; \
1476 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1477 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1478 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1481 #define ffetarget_gt_real2(res,l,r) \
1482 ({ REAL_VALUE_TYPE lr, rr; \
1483 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1484 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1485 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1489 #define ffetarget_gt_real1(res,l,r) \
1490 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1491 #define ffetarget_gt_real2(res,l,r) \
1492 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1494 #define ffetarget_hexxmil(v,t) ffetarget_typeless_hex (v, t)
1495 #define ffetarget_hexxvxt(v,t) ffetarget_typeless_hex (v, t)
1496 #define ffetarget_hexzmil(v,t) ffetarget_typeless_hex (v, t)
1497 #define ffetarget_hexzvxt(v,t) ffetarget_typeless_hex (v, t)
1498 #define ffetarget_init_0()
1499 #define ffetarget_init_1()
1500 #define ffetarget_init_2()
1501 #define ffetarget_init_3()
1502 #define ffetarget_init_4()
1503 #ifdef FFETARGET_32bit_longs
1504 #define ffetarget_integerdefault_is_magical(i) \
1505 (((unsigned long int) i) == FFETARGET_integerBIG_MAGICAL)
1507 #define ffetarget_integerdefault_is_magical(i) \
1508 (((unsigned int) i) == FFETARGET_integerBIG_MAGICAL)
1510 #ifdef REAL_ARITHMETIC
1511 #define ffetarget_iszero_real1(l) \
1512 ({ REAL_VALUE_TYPE lr; \
1513 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1514 REAL_VALUES_EQUAL (lr, dconst0); \
1516 #define ffetarget_iszero_real2(l) \
1517 ({ REAL_VALUE_TYPE lr; \
1518 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1519 REAL_VALUES_EQUAL (lr, dconst0); \
1522 #define ffetarget_iszero_real1(l) ((l) == 0.)
1523 #define ffetarget_iszero_real2(l) ((l) == 0.)
1525 #define ffetarget_iszero_typeless(l) ((l) == 0)
1526 #define ffetarget_logical1(v,truth) (*(v) = truth ? 1 : 0)
1527 #define ffetarget_le_integer1(res,l,r) \
1528 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1529 #define ffetarget_le_integer2(res,l,r) \
1530 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1531 #define ffetarget_le_integer3(res,l,r) \
1532 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1533 #define ffetarget_le_integer4(res,l,r) \
1534 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1535 #ifdef REAL_ARITHMETIC
1536 #define ffetarget_le_real1(res,l,r) \
1537 ({ REAL_VALUE_TYPE lr, rr; \
1538 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1539 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1540 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1543 #define ffetarget_le_real2(res,l,r) \
1544 ({ REAL_VALUE_TYPE lr, rr; \
1545 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1546 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1547 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1551 #define ffetarget_le_real1(res,l,r) \
1552 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1553 #define ffetarget_le_real2(res,l,r) \
1554 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1556 #define ffetarget_lt_integer1(res,l,r) \
1557 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1558 #define ffetarget_lt_integer2(res,l,r) \
1559 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1560 #define ffetarget_lt_integer3(res,l,r) \
1561 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1562 #define ffetarget_lt_integer4(res,l,r) \
1563 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1564 #ifdef REAL_ARITHMETIC
1565 #define ffetarget_lt_real1(res,l,r) \
1566 ({ REAL_VALUE_TYPE lr, rr; \
1567 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1568 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1569 *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
1571 #define ffetarget_lt_real2(res,l,r) \
1572 ({ REAL_VALUE_TYPE lr, rr; \
1573 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1574 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1575 *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
1578 #define ffetarget_lt_real1(res,l,r) \
1579 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1580 #define ffetarget_lt_real2(res,l,r) \
1581 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1583 #define ffetarget_length_character1(c) ((c).length)
1584 #define ffetarget_length_characterdefault ffetarget_length_character1
1585 #ifdef REAL_ARITHMETIC
1586 #define ffetarget_make_real1(res,lr) \
1587 ffetarget_cvt_rv_to_r1_ ((lr), *(res))
1588 #define ffetarget_make_real2(res,lr) \
1589 ffetarget_cvt_rv_to_r2_ ((lr), &((res)->v[0]))
1591 #define ffetarget_make_real1(res,lr) (*(res) = (lr))
1592 #define ffetarget_make_real2(res,lr) (*(res) = (lr))
1594 #define ffetarget_multiply_integer1(res,l,r) (*(res) = (l) * (r), FFEBAD)
1595 #define ffetarget_multiply_integer2(res,l,r) (*(res) = (l) * (r), FFEBAD)
1596 #define ffetarget_multiply_integer3(res,l,r) (*(res) = (l) * (r), FFEBAD)
1597 #define ffetarget_multiply_integer4(res,l,r) (*(res) = (l) * (r), FFEBAD)
1598 #ifdef REAL_ARITHMETIC
1599 #define ffetarget_multiply_real1(res,l,r) \
1600 ({ REAL_VALUE_TYPE lr, rr, resr; \
1601 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1602 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1603 REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
1604 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1606 #define ffetarget_multiply_real2(res,l,r) \
1607 ({ REAL_VALUE_TYPE lr, rr, resr; \
1608 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1609 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1610 REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
1611 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1614 #define ffetarget_multiply_real1(res,l,r) (*(res) = (l) * (r), FFEBAD)
1615 #define ffetarget_multiply_real2(res,l,r) (*(res) = (l) * (r), FFEBAD)
1617 #ifdef REAL_ARITHMETIC
1618 #define ffetarget_ne_complex1(res,l,r) \
1619 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1620 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1621 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1622 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1623 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1624 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1627 #define ffetarget_ne_complex2(res,l,r) \
1628 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1629 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1630 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1631 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1632 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1633 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1637 #define ffetarget_ne_complex1(res,l,r) \
1638 (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \
1639 ? TRUE : FALSE, FFEBAD)
1640 #define ffetarget_ne_complex2(res,l,r) \
1641 (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \
1642 ? TRUE : FALSE, FFEBAD)
1644 #define ffetarget_ne_integer1(res,l,r) \
1645 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1646 #define ffetarget_ne_integer2(res,l,r) \
1647 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1648 #define ffetarget_ne_integer3(res,l,r) \
1649 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1650 #define ffetarget_ne_integer4(res,l,r) \
1651 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1652 #ifdef REAL_ARITHMETIC
1653 #define ffetarget_ne_real1(res,l,r) \
1654 ({ REAL_VALUE_TYPE lr, rr; \
1655 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1656 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1657 *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
1659 #define ffetarget_ne_real2(res,l,r) \
1660 ({ REAL_VALUE_TYPE lr, rr; \
1661 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1662 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1663 *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
1666 #define ffetarget_ne_real1(res,l,r) \
1667 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1668 #define ffetarget_ne_real2(res,l,r) \
1669 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1671 #define ffetarget_neqv_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1672 #define ffetarget_neqv_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1673 #define ffetarget_neqv_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1674 #define ffetarget_neqv_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1675 #define ffetarget_neqv_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
1676 #define ffetarget_neqv_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
1677 #define ffetarget_neqv_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
1678 #define ffetarget_neqv_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
1679 #define ffetarget_not_integer1(res,l) (*(res) = ~(l), FFEBAD)
1680 #define ffetarget_not_integer2(res,l) (*(res) = ~(l), FFEBAD)
1681 #define ffetarget_not_integer3(res,l) (*(res) = ~(l), FFEBAD)
1682 #define ffetarget_not_integer4(res,l) (*(res) = ~(l), FFEBAD)
1683 #define ffetarget_not_logical1(res,l) (*(res) = !(l), FFEBAD)
1684 #define ffetarget_not_logical2(res,l) (*(res) = !(l), FFEBAD)
1685 #define ffetarget_not_logical3(res,l) (*(res) = !(l), FFEBAD)
1686 #define ffetarget_not_logical4(res,l) (*(res) = !(l), FFEBAD)
1687 #define ffetarget_octalmil(v,t) ffetarget_typeless_octal (v, t)
1688 #define ffetarget_octalvxt(v,t) ffetarget_typeless_octal (v, t)
1689 #define ffetarget_offset(res,l) (*(res) = (l), TRUE) /* Overflow? */
1690 #define ffetarget_offset_add(res,l,r) (*(res) = (l) + (r), TRUE) /* Overflow? */
1691 #define ffetarget_offset_charsize(res,l,u) (*(res) = (l) * (u), TRUE) /* Ov? */
1692 #define ffetarget_offset_multiply(res,l,r) (*(res) = (l) * (r), TRUE) /* Ov? */
1693 #define ffetarget_offset_overflow(text) ((void) 0) /* ~~no message? */
1694 #define ffetarget_or_integer1(res,l,r) (*(res) = (l) | (r), FFEBAD)
1695 #define ffetarget_or_integer2(res,l,r) (*(res) = (l) | (r), FFEBAD)
1696 #define ffetarget_or_integer3(res,l,r) (*(res) = (l) | (r), FFEBAD)
1697 #define ffetarget_or_integer4(res,l,r) (*(res) = (l) | (r), FFEBAD)
1698 #define ffetarget_or_logical1(res,l,r) (*(res) = (l) || (r), FFEBAD)
1699 #define ffetarget_or_logical2(res,l,r) (*(res) = (l) || (r), FFEBAD)
1700 #define ffetarget_or_logical3(res,l,r) (*(res) = (l) || (r), FFEBAD)
1701 #define ffetarget_or_logical4(res,l,r) (*(res) = (l) || (r), FFEBAD)
1702 #define ffetarget_print_binarymil(f,v) ffetarget_print_binary (f, v)
1703 #define ffetarget_print_binaryvxt(f,v) ffetarget_print_binary (f, v)
1704 #define ffetarget_print_hexxmil(f,v) ffetarget_print_hex (f, v)
1705 #define ffetarget_print_hexxvxt(f,v) ffetarget_print_hex (f, v)
1706 #define ffetarget_print_hexzmil(f,v) ffetarget_print_hex (f, v)
1707 #define ffetarget_print_hexzvxt(f,v) ffetarget_print_hex (f, v)
1708 #define ffetarget_print_integer1(f,v) \
1709 fprintf ((f), "%" ffetargetInteger1_f "d", (v))
1710 #define ffetarget_print_integer2(f,v) \
1711 fprintf ((f), "%" ffetargetInteger2_f "d", (v))
1712 #define ffetarget_print_integer3(f,v) \
1713 fprintf ((f), "%" ffetargetInteger3_f "d", (v))
1714 #define ffetarget_print_integer4(f,v) \
1715 fprintf ((f), "%" ffetargetInteger4_f "d", (v))
1716 #define ffetarget_print_logical1(f,v) \
1717 fprintf ((f), "%" ffetargetLogical1_f "d", (v))
1718 #define ffetarget_print_logical2(f,v) \
1719 fprintf ((f), "%" ffetargetLogical2_f "d", (v))
1720 #define ffetarget_print_logical3(f,v) \
1721 fprintf ((f), "%" ffetargetLogical3_f "d", (v))
1722 #define ffetarget_print_logical4(f,v) \
1723 fprintf ((f), "%" ffetargetLogical4_f "d", (v))
1724 #define ffetarget_print_octalmil(f,v) ffetarget_print_octal(f,v)
1725 #define ffetarget_print_octalvxt(f,v) ffetarget_print_octal(f,v)
1726 #ifdef REAL_ARITHMETIC
1727 #define ffetarget_print_real1(f,l) \
1728 ({ REAL_VALUE_TYPE lr; \
1729 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1730 REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
1731 fputs (ffetarget_string_, (f)); \
1733 #define ffetarget_print_real2(f,l) \
1734 ({ REAL_VALUE_TYPE lr; \
1735 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1736 REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
1737 fputs (ffetarget_string_, (f)); \
1740 #define ffetarget_print_real1(f,v) \
1741 fprintf ((f), "%" ffetargetReal1_f "g", (v))
1742 #define ffetarget_print_real2(f,v) \
1743 fprintf ((f), "%" ffetargetReal2_f "g", (v))
1745 #ifdef REAL_ARITHMETIC
1746 #define ffetarget_real1_one(res) ffetarget_cvt_rv_to_r1_ (dconst1, *(res))
1747 #define ffetarget_real2_one(res) ffetarget_cvt_rv_to_r2_ (dconst1, &((res)->v[0]))
1749 #define ffetarget_real1_one(res) (*(res) = (float) 1.)
1750 #define ffetarget_real2_one(res) (*(res) = 1.)
1752 #ifdef REAL_ARITHMETIC
1753 #define ffetarget_real1_two(res) ffetarget_cvt_rv_to_r1_ (dconst2, *(res))
1754 #define ffetarget_real2_two(res) ffetarget_cvt_rv_to_r2_ (dconst2, &((res)->v[0]))
1756 #define ffetarget_real1_two(res) (*(res) = (float) 2.)
1757 #define ffetarget_real2_two(res) (*(res) = 2.)
1759 #ifdef REAL_ARITHMETIC
1760 #define ffetarget_real1_zero(res) ffetarget_cvt_rv_to_r1_ (dconst0, *(res))
1761 #define ffetarget_real2_zero(res) ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0]))
1763 #define ffetarget_real1_zero(res) (*(res) = (float) 0.)
1764 #define ffetarget_real2_zero(res) (*(res) = 0.)
1766 #define ffetarget_size_typeless_binary(t) ((ffetarget_num_digits_(t) + 7) / 8)
1767 #define ffetarget_size_typeless_octal(t) \
1768 ((ffetarget_num_digits_(t) * 3 + 7) / 8)
1769 #define ffetarget_size_typeless_hex(t) ((ffetarget_num_digits_(t) + 1) / 2)
1770 #ifdef REAL_ARITHMETIC
1771 #define ffetarget_subtract_complex1(res,l,r) \
1772 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
1773 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1774 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1775 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1776 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1777 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1778 REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
1779 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
1780 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
1782 #define ffetarget_subtract_complex2(res,l,r) \
1783 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
1784 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1785 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1786 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1787 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1788 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1789 REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
1790 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1791 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1794 #define ffetarget_subtract_complex1(res,l,r) \
1795 ((res)->real = (l).real - (r).real, \
1796 (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
1797 #define ffetarget_subtract_complex2(res,l,r) \
1798 ((res)->real = (l).real - (r).real, \
1799 (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
1801 #define ffetarget_subtract_integer1(res,l,r) (*(res) = (l) - (r), FFEBAD)
1802 #define ffetarget_subtract_integer2(res,l,r) (*(res) = (l) - (r), FFEBAD)
1803 #define ffetarget_subtract_integer3(res,l,r) (*(res) = (l) - (r), FFEBAD)
1804 #define ffetarget_subtract_integer4(res,l,r) (*(res) = (l) - (r), FFEBAD)
1805 #ifdef REAL_ARITHMETIC
1806 #define ffetarget_subtract_real1(res,l,r) \
1807 ({ REAL_VALUE_TYPE lr, rr, resr; \
1808 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1809 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1810 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1811 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1813 #define ffetarget_subtract_real2(res,l,r) \
1814 ({ REAL_VALUE_TYPE lr, rr, resr; \
1815 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1816 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1817 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1818 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1821 #define ffetarget_subtract_real1(res,l,r) (*(res) = (l) - (r), FFEBAD)
1822 #define ffetarget_subtract_real2(res,l,r) (*(res) = (l) - (r), FFEBAD)
1824 #define ffetarget_terminate_0()
1825 #define ffetarget_terminate_1()
1826 #define ffetarget_terminate_2()
1827 #define ffetarget_terminate_3()
1828 #define ffetarget_terminate_4()
1829 #define ffetarget_text_character1(c) ((c).text)
1830 #define ffetarget_text_characterdefault ffetarget_text_character1
1831 #ifdef REAL_ARITHMETIC
1832 #define ffetarget_uminus_complex1(res,l) \
1833 ({ REAL_VALUE_TYPE lr, li, resr, resi; \
1834 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1835 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1836 resr = REAL_VALUE_NEGATE (lr); \
1837 resi = REAL_VALUE_NEGATE (li); \
1838 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
1839 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
1841 #define ffetarget_uminus_complex2(res,l) \
1842 ({ REAL_VALUE_TYPE lr, li, resr, resi; \
1843 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1844 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1845 resr = REAL_VALUE_NEGATE (lr); \
1846 resi = REAL_VALUE_NEGATE (li); \
1847 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1848 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1851 #define ffetarget_uminus_complex1(res,l) \
1852 ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
1853 #define ffetarget_uminus_complex2(res,l) \
1854 ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
1856 #define ffetarget_uminus_integer1(res,l) (*(res) = -(l), FFEBAD)
1857 #define ffetarget_uminus_integer2(res,l) (*(res) = -(l), FFEBAD)
1858 #define ffetarget_uminus_integer3(res,l) (*(res) = -(l), FFEBAD)
1859 #define ffetarget_uminus_integer4(res,l) (*(res) = -(l), FFEBAD)
1860 #ifdef REAL_ARITHMETIC
1861 #define ffetarget_uminus_real1(res,l) \
1862 ({ REAL_VALUE_TYPE lr, resr; \
1863 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1864 resr = REAL_VALUE_NEGATE (lr); \
1865 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1867 #define ffetarget_uminus_real2(res,l) \
1868 ({ REAL_VALUE_TYPE lr, resr; \
1869 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1870 resr = REAL_VALUE_NEGATE (lr); \
1871 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1874 #define ffetarget_uminus_real1(res,l) (*(res) = -(l), FFEBAD)
1875 #define ffetarget_uminus_real2(res,l) (*(res) = -(l), FFEBAD)
1877 #ifdef REAL_ARITHMETIC
1878 #define ffetarget_value_real1(lr) ffetarget_cvt_r1_to_rv_ ((lr))
1879 #define ffetarget_value_real2(lr) ffetarget_cvt_r2_to_rv_ (&((lr).v[0]))
1881 #define ffetarget_value_real1
1882 #define ffetarget_value_real2
1884 #define ffetarget_xor_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1885 #define ffetarget_xor_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1886 #define ffetarget_xor_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1887 #define ffetarget_xor_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1888 #define ffetarget_xor_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
1889 #define ffetarget_xor_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
1890 #define ffetarget_xor_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
1891 #define ffetarget_xor_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
1893 /* End of #include file. */
1895 #endif /* ! GCC_F_TARGET_H */