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. */
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
239 typedef unsigned char ffetargetAlign
; /* ffetargetOffset for alignment. */
240 #define ffetargetAlign_f ""
241 typedef long ffetargetCharacterSize
;
242 #define ffetargetCharacterSize_f "l"
243 typedef void (*ffetargetCopyfunc
) (void *, void *, size_t);
244 typedef ffetargetCharacterSize ffetargetHollerithSize
;
245 #define ffetargetHollerithSize_f "l"
246 typedef long long ffetargetOffset
;
247 #define ffetargetOffset_f "ll"
249 #if FFETARGET_okINTEGER1
250 #if !defined(__alpha__) && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__)))
251 typedef long int ffetargetInteger1
;
252 #define ffetargetInteger1_f "l"
254 typedef int ffetargetInteger1
;
255 #define ffetargetInteger1_f ""
258 #if FFETARGET_okINTEGER2
259 typedef signed char ffetargetInteger2
;
260 #define ffetargetInteger2_f ""
262 #if FFETARGET_okINTEGER3
263 typedef short int ffetargetInteger3
;
264 #define ffetargetInteger3_f ""
266 #if FFETARGET_okINTEGER4
267 typedef long long int ffetargetInteger4
;
268 #define ffetargetInteger4_f "ll"
270 #if FFETARGET_okINTEGER5
271 typedef ? ffetargetInteger5
;
272 #define ffetargetInteger5_f
275 #if FFETARGET_okINTEGER6
276 typedef ? ffetargetInteger6
;
277 #define ffetargetInteger6_f
280 #if FFETARGET_okINTEGER7
281 typedef ? ffetargetInteger7
;
282 #define ffetargetInteger7_f
285 #if FFETARGET_okINTEGER8
286 typedef ? ffetargetInteger8
;
287 #define ffetargetInteger8_f
290 #if FFETARGET_okLOGICAL1
291 #if !defined(__alpha__) && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__)))
292 typedef long int ffetargetLogical1
;
293 #define ffetargetLogical1_f "l"
295 typedef int ffetargetLogical1
;
296 #define ffetargetLogical1_f ""
299 #if FFETARGET_okLOGICAL2
300 typedef signed char ffetargetLogical2
;
301 #define ffetargetLogical2_f ""
303 #if FFETARGET_okLOGICAL3
304 typedef short int ffetargetLogical3
;
305 #define ffetargetLogical3_f ""
307 #if FFETARGET_okLOGICAL4
308 typedef long long int ffetargetLogical4
;
309 #define ffetargetLogical4_f "ll"
311 #if FFETARGET_okLOGICAL5
312 typedef ? ffetargetLogical5
;
313 #define ffetargetLogical5_f
316 #if FFETARGET_okLOGICAL6
317 typedef ? ffetargetLogical6
;
318 #define ffetargetLogical6_f
321 #if FFETARGET_okLOGICAL7
322 typedef ? ffetargetLogical7
;
323 #define ffetargetLogical7_f
326 #if FFETARGET_okLOGICAL8
327 typedef ? ffetargetLogical8
;
328 #define ffetargetLogical8_f
331 #if FFETARGET_okREAL1
332 #ifdef REAL_ARITHMETIC
333 #if !defined(__alpha__) && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__)))
334 typedef long int ffetargetReal1
;
335 #define ffetargetReal1_f "l"
336 #define ffetarget_cvt_r1_to_rv_ REAL_VALUE_UNTO_TARGET_SINGLE
337 #define ffetarget_cvt_rv_to_r1_ REAL_VALUE_TO_TARGET_SINGLE
339 typedef int ffetargetReal1
;
340 #define ffetargetReal1_f ""
341 #define ffetarget_cvt_r1_to_rv_(in) \
342 ({ REAL_VALUE_TYPE _rv; \
343 _rv = REAL_VALUE_UNTO_TARGET_SINGLE ((long) (in)); \
345 #define ffetarget_cvt_rv_to_r1_(in, out) \
347 REAL_VALUE_TO_TARGET_SINGLE ((in), _tmp); \
348 (out) = (ffetargetReal1) _tmp; })
350 #else /* REAL_ARITHMETIC */
351 typedef float ffetargetReal1
;
352 #define ffetargetReal1_f ""
353 #endif /* REAL_ARITHMETIC */
355 #if FFETARGET_okREAL2
356 #ifdef REAL_ARITHMETIC
357 #if !defined(__alpha__) && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__)))
363 #define ffetargetReal2_f "l"
364 #define ffetarget_cvt_r2_to_rv_ REAL_VALUE_UNTO_TARGET_DOUBLE
365 #define ffetarget_cvt_rv_to_r2_ REAL_VALUE_TO_TARGET_DOUBLE
372 #define ffetargetReal2_f ""
373 #define ffetarget_cvt_r2_to_rv_(in) \
374 ({ REAL_VALUE_TYPE _rv; \
378 _rv = REAL_VALUE_UNTO_TARGET_DOUBLE (_tmp); \
380 #define ffetarget_cvt_rv_to_r2_(in, out) \
382 REAL_VALUE_TO_TARGET_DOUBLE ((in), _tmp); \
383 (out)[0] = (int) (_tmp[0]); \
384 (out)[1] = (int) (_tmp[1]); })
387 typedef double ffetargetReal2
;
388 #define ffetargetReal2_f ""
391 #if FFETARGET_okREAL3
392 #ifdef REAL_ARITHMETIC
393 typedef long ffetargetReal3
[?];
395 typedef ? ffetargetReal3
;
396 #define ffetargetReal3_f
400 #if FFETARGET_okREAL4
401 #ifdef REAL_ARITHMETIC
402 typedef long ffetargetReal4
[?];
404 typedef ? ffetargetReal4
;
405 #define ffetargetReal4_f
409 #if FFETARGET_okREAL5
410 #ifdef REAL_ARITHMETIC
411 typedef long ffetargetReal5
[?];
413 typedef ? ffetargetReal5
;
414 #define ffetargetReal5_f
418 #if FFETARGET_okREAL6
419 #ifdef REAL_ARITHMETIC
420 typedef long ffetargetReal6
[?];
422 typedef ? ffetargetReal6
;
423 #define ffetargetReal6_f
427 #if FFETARGET_okREAL7
428 #ifdef REAL_ARITHMETIC
429 typedef long ffetargetReal7
[?];
431 typedef ? ffetargetReal7
;
432 #define ffetargetReal7_f
436 #if FFETARGET_okREAL8
437 #ifdef REAL_ARITHMETIC
438 typedef long ffetargetReal8
[?];
440 typedef ? ffetargetReal8
;
441 #define ffetargetReal8_f
445 #if FFETARGET_okCOMPLEX1
446 struct _ffetarget_complex_1_
449 ffetargetReal1 imaginary
;
451 typedef struct _ffetarget_complex_1_ ffetargetComplex1
;
453 #if FFETARGET_okCOMPLEX2
454 struct _ffetarget_complex_2_
457 ffetargetReal2 imaginary
;
459 typedef struct _ffetarget_complex_2_ ffetargetComplex2
;
461 #if FFETARGET_okCOMPLEX3
462 struct _ffetarget_complex_3_
465 ffetargetReal3 imaginary
;
467 typedef struct _ffetarget_complex_3_ ffetargetComplex3
;
469 #if FFETARGET_okCOMPLEX4
470 struct _ffetarget_complex_4_
473 ffetargetReal4 imaginary
;
475 typedef struct _ffetarget_complex_4_ ffetargetComplex4
;
477 #if FFETARGET_okCOMPLEX5
478 struct _ffetarget_complex_5_
481 ffetargetReal5 imaginary
;
483 typedef struct _ffetarget_complex_5_ ffetargetComplex5
;
485 #if FFETARGET_okCOMPLEX6
486 struct _ffetarget_complex_6_
489 ffetargetReal6 imaginary
;
491 typedef struct _ffetarget_complex_6_ ffetargetComplex6
;
493 #if FFETARGET_okCOMPLEX7
494 struct _ffetarget_complex_7_
497 ffetargetReal7 imaginary
;
499 typedef struct _ffetarget_complex_7_ ffetargetComplex7
;
501 #if FFETARGET_okCOMPLEX8
502 struct _ffetarget_complex_8_
505 ffetargetReal8 imaginary
;
507 typedef struct _ffetarget_complex_8_ ffetargetComplex8
;
509 #if FFETARGET_okCHARACTER1
510 struct _ffetarget_char_1_
512 ffetargetCharacterSize length
;
515 typedef struct _ffetarget_char_1_ ffetargetCharacter1
;
516 typedef unsigned char ffetargetCharacterUnit1
;
518 #if FFETARGET_okCHARACTER2
519 typedef ? ffetargetCharacter2
;
520 typedef ? ffetargetCharacterUnit2
;
522 #if FFETARGET_okCHARACTER3
523 typedef ? ffetargetCharacter3
;
524 typedef ? ffetargetCharacterUnit3
;
526 #if FFETARGET_okCHARACTER4
527 typedef ? ffetargetCharacter4
;
528 typedef ? ffetargetCharacterUnit4
;
530 #if FFETARGET_okCHARACTER5
531 typedef ? ffetargetCharacter5
;
532 typedef ? ffetargetCharacterUnit5
;
534 #if FFETARGET_okCHARACTER6
535 typedef ? ffetargetCharacter6
;
536 typedef ? ffetargetCharacterUnit6
;
538 #if FFETARGET_okCHARACTER7
539 typedef ? ffetargetCharacter7
;
540 typedef ? ffetargetCharacterUnit7
;
542 #if FFETARGET_okCHARACTER8
543 typedef ? ffetargetCharacter8
;
544 typedef ? ffetargetCharacterUnit8
;
547 typedef unsigned long long int ffetargetTypeless
;
549 struct _ffetarget_hollerith_
551 ffetargetHollerithSize length
;
554 typedef struct _ffetarget_hollerith_ ffetargetHollerith
;
556 typedef ffetargetCharacter1 ffetargetCharacterDefault
;
557 typedef ffetargetComplex1 ffetargetComplexDefault
;
558 #if FFETARGET_okCOMPLEXDOUBLE
559 typedef ffetargetComplex2 ffetargetComplexDouble
;
561 #if FFETARGET_okCOMPLEXQUAD
562 typedef ffetargetComplex3 ffetargetComplexQuad
;
564 typedef ffetargetInteger1 ffetargetIntegerDefault
;
565 #define ffetargetIntegerDefault_f ffetargetInteger1_f
566 typedef ffetargetLogical1 ffetargetLogicalDefault
;
567 #define ffetargetLogicalDefault_f ffetargetLogical1_f
568 typedef ffetargetReal1 ffetargetRealDefault
;
569 #define ffetargetRealDefault_f ffetargetReal1_f
570 typedef ffetargetReal2 ffetargetRealDouble
;
571 #define ffetargetRealDouble_f ffetargetReal2_f
572 #if FFETARGET_okREALQUAD
573 typedef ffetargetReal3 ffetargetRealQuad
;
574 #define ffetargetRealQuad_f ffetargetReal3_f
577 /* Include files needed by this one. */
584 /* Structure definitions. */
587 /* Global objects accessed by users of this module. */
589 extern char ffetarget_string_
[40]; /* Temp for ascii-to-double (atof). */
590 extern HOST_WIDE_INT ffetarget_long_val_
;
591 extern HOST_WIDE_INT ffetarget_long_junk_
;
593 /* Declare functions with prototypes. */
595 void ffetarget_aggregate_info (ffeinfoBasictype
*ebt
, ffeinfoKindtype
*ekt
,
596 ffetargetAlign
*units
, ffeinfoBasictype abt
,
597 ffeinfoKindtype akt
);
598 ffetargetAlign
ffetarget_align (ffetargetAlign
*updated_alignment
,
599 ffetargetAlign
*updated_modulo
,
600 ffetargetOffset offset
,
601 ffetargetAlign alignment
,
602 ffetargetAlign modulo
);
603 #if FFETARGET_okCHARACTER1
604 bool ffetarget_character1 (ffetargetCharacter1
*val
, ffelexToken character
,
606 int ffetarget_cmp_character1 (ffetargetCharacter1 l
, ffetargetCharacter1 r
);
607 ffebad
ffetarget_concatenate_character1 (ffetargetCharacter1
*res
,
608 ffetargetCharacter1 l
,
609 ffetargetCharacter1 r
,
611 ffetargetCharacterSize
*len
);
612 ffebad
ffetarget_convert_character1_character1 (ffetargetCharacter1
*res
,
613 ffetargetCharacterSize res_size
,
614 ffetargetCharacter1 l
,
616 ffebad
ffetarget_convert_character1_hollerith (ffetargetCharacter1
*res
,
617 ffetargetCharacterSize res_size
,
618 ffetargetHollerith l
,
620 ffebad
ffetarget_convert_character1_integer4 (ffetargetCharacter1
*res
,
621 ffetargetCharacterSize res_size
,
624 ffebad
ffetarget_convert_character1_logical4 (ffetargetCharacter1
*res
,
625 ffetargetCharacterSize res_size
,
628 ffebad
ffetarget_convert_character1_typeless (ffetargetCharacter1
*res
,
629 ffetargetCharacterSize res_size
,
632 ffebad
ffetarget_eq_character1 (bool *res
, ffetargetCharacter1 l
,
633 ffetargetCharacter1 r
);
634 ffebad
ffetarget_le_character1 (bool *res
, ffetargetCharacter1 l
,
635 ffetargetCharacter1 r
);
636 ffebad
ffetarget_ge_character1 (bool *res
, ffetargetCharacter1 l
,
637 ffetargetCharacter1 r
);
638 ffebad
ffetarget_gt_character1 (bool *res
, ffetargetCharacter1 l
,
639 ffetargetCharacter1 r
);
640 ffebad
ffetarget_lt_character1 (bool *res
, ffetargetCharacter1 l
,
641 ffetargetCharacter1 r
);
642 ffebad
ffetarget_ne_character1 (bool *res
, ffetargetCharacter1 l
,
643 ffetargetCharacter1 r
);
644 ffebad
ffetarget_substr_character1 (ffetargetCharacter1
*res
,
645 ffetargetCharacter1 l
,
646 ffetargetCharacterSize first
,
647 ffetargetCharacterSize last
,
649 ffetargetCharacterSize
*len
);
651 int ffetarget_cmp_hollerith (ffetargetHollerith l
, ffetargetHollerith r
);
652 bool ffetarget_hollerith (ffetargetHollerith
*val
, ffelexToken hollerith
,
654 int ffetarget_cmp_typeless (ffetargetTypeless l
, ffetargetTypeless r
);
655 ffebad
ffetarget_convert_any_character1_ (char *res
, size_t size
,
656 ffetargetCharacter1 l
);
657 ffebad
ffetarget_convert_any_hollerith_ (char *res
, size_t size
,
658 ffetargetHollerith l
);
659 ffebad
ffetarget_convert_any_typeless_ (char *res
, size_t size
,
660 ffetargetTypeless l
);
661 #if FFETARGET_okCOMPLEX1
662 ffebad
ffetarget_divide_complex1 (ffetargetComplex1
*res
, ffetargetComplex1 l
,
663 ffetargetComplex1 r
);
665 #if FFETARGET_okCOMPLEX2
666 ffebad
ffetarget_divide_complex2 (ffetargetComplex2
*res
, ffetargetComplex2 l
,
667 ffetargetComplex2 r
);
669 #if FFETARGET_okCOMPLEX3
670 ffebad
ffetarget_divide_complex3 (ffetargetComplex3
*res
, ffetargetComplex3 l
,
671 ffetargetComplex3 r
);
673 #if FFETARGET_okCOMPLEX4
674 ffebad
ffetarget_divide_complex4 (ffetargetComplex4
*res
, ffetargetComplex4 l
,
675 ffetargetComplex4 r
);
677 #if FFETARGET_okCOMPLEX5
678 ffebad
ffetarget_divide_complex5 (ffetargetComplex5
*res
, ffetargetComplex5 l
,
679 ffetargetComplex5 r
);
681 #if FFETARGET_okCOMPLEX6
682 ffebad
ffetarget_divide_complex6 (ffetargetComplex6
*res
, ffetargetComplex6 l
,
683 ffetargetComplex6 r
);
685 #if FFETARGET_okCOMPLEX7
686 ffebad
ffetarget_divide_complex7 (ffetargetComplex7
*res
, ffetargetComplex7 l
,
687 ffetargetComplex7 r
);
689 #if FFETARGET_okCOMPLEX8
690 ffebad
ffetarget_divide_complex8 (ffetargetComplex8
*res
, ffetargetComplex8 l
,
691 ffetargetComplex8 r
);
693 #if FFETARGET_okINTEGER1
694 bool ffetarget_integer1 (ffetargetInteger1
*val
, ffelexToken integer
);
696 #if FFETARGET_okINTEGER2
697 bool ffetarget_integer2 (ffetargetInteger2
*val
, ffelexToken integer
);
699 #if FFETARGET_okINTEGER3
700 bool ffetarget_integer3 (ffetargetInteger3
*val
, ffelexToken integer
);
702 #if FFETARGET_okINTEGER4
703 bool ffetarget_integer4 (ffetargetInteger4
*val
, ffelexToken integer
);
705 #if FFETARGET_okINTEGER5
706 bool ffetarget_integer5 (ffetargetInteger5
*val
, ffelexToken integer
);
708 #if FFETARGET_okINTEGER6
709 bool ffetarget_integer6 (ffetargetInteger6
*val
, ffelexToken integer
);
711 #if FFETARGET_okINTEGER7
712 bool ffetarget_integer7 (ffetargetInteger7
*val
, ffelexToken integer
);
714 #if FFETARGET_okINTEGER8
715 bool ffetarget_integer8 (ffetargetInteger8
*val
, ffelexToken integer
);
717 bool ffetarget_integerbinary (ffetargetIntegerDefault
*val
,
718 ffelexToken integer
);
719 bool ffetarget_integerhex (ffetargetIntegerDefault
*val
,
720 ffelexToken integer
);
721 bool ffetarget_integeroctal (ffetargetIntegerDefault
*val
,
722 ffelexToken integer
);
723 void ffetarget_integer_bad_magical (ffelexToken t
);
724 void ffetarget_integer_bad_magical_binary (ffelexToken integer
, ffelexToken minus
);
725 void ffetarget_integer_bad_magical_precedence (ffelexToken integer
,
727 ffelexToken higher_op
);
728 void ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer
,
730 ffelexToken higher_op
);
731 #if FFETARGET_okCHARACTER1
732 bool ffetarget_iszero_character1 (ffetargetCharacter1 constant
);
734 bool ffetarget_iszero_hollerith (ffetargetHollerith constant
);
735 void ffetarget_layout (const char *error_text
, ffetargetAlign
*alignment
,
736 ffetargetAlign
*modulo
, ffetargetOffset
*size
,
737 ffeinfoBasictype bt
, ffeinfoKindtype kt
,
738 ffetargetCharacterSize charsize
,
739 ffetargetIntegerDefault num_elements
);
740 #if FFETARGET_okCOMPLEX1
741 ffebad
ffetarget_multiply_complex1 (ffetargetComplex1
*res
,
743 ffetargetComplex1 r
);
745 #if FFETARGET_okCOMPLEX2
746 ffebad
ffetarget_multiply_complex2 (ffetargetComplex2
*res
,
748 ffetargetComplex2 r
);
750 #if FFETARGET_okCOMPLEX3
751 ffebad
ffetarget_multiply_complex3 (ffetargetComplex3
*res
,
753 ffetargetComplex3 r
);
755 #if FFETARGET_okCOMPLEX4
756 ffebad
ffetarget_multiply_complex4 (ffetargetComplex4
*res
,
758 ffetargetComplex4 r
);
760 #if FFETARGET_okCOMPLEX5
761 ffebad
ffetarget_multiply_complex5 (ffetargetComplex5
*res
,
763 ffetargetComplex5 r
);
765 #if FFETARGET_okCOMPLEX6
766 ffebad
ffetarget_multiply_complex6 (ffetargetComplex6
*res
,
768 ffetargetComplex6 r
);
770 #if FFETARGET_okCOMPLEX7
771 ffebad
ffetarget_multiply_complex7 (ffetargetComplex7
*res
,
773 ffetargetComplex7 r
);
775 #if FFETARGET_okCOMPLEX8
776 ffebad
ffetarget_multiply_complex8 (ffetargetComplex8
*res
,
778 ffetargetComplex8 r
);
780 ffebad
ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault
*res
,
781 ffetargetComplexDefault l
,
782 ffetargetIntegerDefault r
);
783 #if FFETARGET_okCOMPLEXDOUBLE
784 ffebad
ffetarget_power_complexdouble_integerdefault (ffetargetComplexDouble
*res
,
785 ffetargetComplexDouble l
,
786 ffetargetIntegerDefault r
);
788 ffebad
ffetarget_power_integerdefault_integerdefault (ffetargetIntegerDefault
*res
,
789 ffetargetIntegerDefault l
,
790 ffetargetIntegerDefault r
);
791 ffebad
ffetarget_power_realdefault_integerdefault (ffetargetRealDefault
*res
,
792 ffetargetRealDefault l
,
793 ffetargetIntegerDefault r
);
794 ffebad
ffetarget_power_realdouble_integerdefault (ffetargetRealDouble
*res
,
795 ffetargetRealDouble l
,
796 ffetargetIntegerDefault r
);
797 void ffetarget_print_binary (FILE *f
, ffetargetTypeless val
);
798 void ffetarget_print_character1 (FILE *f
, ffetargetCharacter1 val
);
799 void ffetarget_print_hollerith (FILE *f
, ffetargetHollerith val
);
800 void ffetarget_print_octal (FILE *f
, ffetargetTypeless val
);
801 void ffetarget_print_hex (FILE *f
, ffetargetTypeless val
);
802 #if FFETARGET_okREAL1
803 bool ffetarget_real1 (ffetargetReal1
*value
, ffelexToken integer
,
804 ffelexToken decimal
, ffelexToken fraction
,
805 ffelexToken exponent
, ffelexToken exponent_sign
,
806 ffelexToken exponent_digits
);
808 #if FFETARGET_okREAL2
809 bool ffetarget_real2 (ffetargetReal2
*value
, ffelexToken integer
,
810 ffelexToken decimal
, ffelexToken fraction
,
811 ffelexToken exponent
, ffelexToken exponent_sign
,
812 ffelexToken exponent_digits
);
814 #if FFETARGET_okREAL3
815 bool ffetarget_real3 (ffetargetReal3
*value
, ffelexToken integer
,
816 ffelexToken decimal
, ffelexToken fraction
,
817 ffelexToken exponent
, ffelexToken exponent_sign
,
818 ffelexToken exponent_digits
);
820 #if FFETARGET_okREAL4
821 bool ffetarget_real4 (ffetargetReal4
*value
, ffelexToken integer
,
822 ffelexToken decimal
, ffelexToken fraction
,
823 ffelexToken exponent
, ffelexToken exponent_sign
,
824 ffelexToken exponent_digits
);
826 #if FFETARGET_okREAL5
827 bool ffetarget_real5 (ffetargetReal5
*value
, ffelexToken integer
,
828 ffelexToken decimal
, ffelexToken fraction
,
829 ffelexToken exponent
, ffelexToken exponent_sign
,
830 ffelexToken exponent_digits
);
832 #if FFETARGET_okREAL6
833 bool ffetarget_real6 (ffetargetReal6
*value
, ffelexToken integer
,
834 ffelexToken decimal
, ffelexToken fraction
,
835 ffelexToken exponent
, ffelexToken exponent_sign
,
836 ffelexToken exponent_digits
);
838 #if FFETARGET_okREAL7
839 bool ffetarget_real7 (ffetargetReal7
*value
, ffelexToken integer
,
840 ffelexToken decimal
, ffelexToken fraction
,
841 ffelexToken exponent
, ffelexToken exponent_sign
,
842 ffelexToken exponent_digits
);
844 #if FFETARGET_okREAL8
845 bool ffetarget_real8 (ffetargetReal8
*value
, ffelexToken integer
,
846 ffelexToken decimal
, ffelexToken fraction
,
847 ffelexToken exponent
, ffelexToken exponent_sign
,
848 ffelexToken exponent_digits
);
850 bool ffetarget_typeless_binary (ffetargetTypeless
*value
, ffelexToken token
);
851 bool ffetarget_typeless_octal (ffetargetTypeless
*value
, ffelexToken token
);
852 bool ffetarget_typeless_hex (ffetargetTypeless
*value
, ffelexToken token
);
853 void ffetarget_verify_character1 (mallocPool pool
, ffetargetCharacter1 val
);
854 int ffetarget_num_digits_ (ffelexToken t
);
855 void *ffetarget_memcpy_ (void *dst
, void *src
, size_t len
);
860 #define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
861 REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), ((kt == 1) ? SFmode : DFmode))
863 #define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
864 REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0))
867 #ifdef REAL_ARITHMETIC
868 #define ffetarget_add_complex1(res,l,r) \
869 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
870 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
871 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
872 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
873 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
874 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
875 REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
876 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
877 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
879 #define ffetarget_add_complex2(res,l,r) \
880 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
881 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
882 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
883 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
884 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
885 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
886 REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
887 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
888 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
891 #define ffetarget_add_complex1(res,l,r) \
892 ((res)->real = (l).real + (r).real, \
893 (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
894 #define ffetarget_add_complex2(res,l,r) \
895 ((res)->real = (l).real + (r).real, \
896 (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
898 #define ffetarget_add_integer1(res,l,r) (*(res) = (l) + (r), FFEBAD)
899 #define ffetarget_add_integer2(res,l,r) (*(res) = (l) + (r), FFEBAD)
900 #define ffetarget_add_integer3(res,l,r) (*(res) = (l) + (r), FFEBAD)
901 #define ffetarget_add_integer4(res,l,r) (*(res) = (l) + (r), FFEBAD)
902 #ifdef REAL_ARITHMETIC
903 #define ffetarget_add_real1(res,l,r) \
904 ({ REAL_VALUE_TYPE lr, rr, resr; \
905 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
906 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
907 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
908 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
910 #define ffetarget_add_real2(res,l,r) \
911 ({ REAL_VALUE_TYPE lr, rr, resr; \
912 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
913 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
914 REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
915 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
918 #define ffetarget_add_real1(res,l,r) (*(res) = (l) + (r), FFEBAD)
919 #define ffetarget_add_real2(res,l,r) (*(res) = (l) + (r), FFEBAD)
921 #define ffetarget_aggregate_ptr_memcpy(dbt,dkt,sbt,skt) \
922 ((ffetargetCopyfunc) ffetarget_memcpy_)
923 #define ffetarget_and_integer1(res,l,r) (*(res) = (l) & (r), FFEBAD)
924 #define ffetarget_and_integer2(res,l,r) (*(res) = (l) & (r), FFEBAD)
925 #define ffetarget_and_integer3(res,l,r) (*(res) = (l) & (r), FFEBAD)
926 #define ffetarget_and_integer4(res,l,r) (*(res) = (l) & (r), FFEBAD)
927 #define ffetarget_and_logical1(res,l,r) (*(res) = (l) && (r), FFEBAD)
928 #define ffetarget_and_logical2(res,l,r) (*(res) = (l) && (r), FFEBAD)
929 #define ffetarget_and_logical3(res,l,r) (*(res) = (l) && (r), FFEBAD)
930 #define ffetarget_and_logical4(res,l,r) (*(res) = (l) && (r), FFEBAD)
931 #define ffetarget_binarymil(v,t) ffetarget_typeless_binary (v, t)
932 #define ffetarget_binaryvxt(v,t) ffetarget_typeless_binary (v, t)
933 #define ffetarget_cmp_integer1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
934 #define ffetarget_cmp_integer2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
935 #define ffetarget_cmp_integer3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
936 #define ffetarget_cmp_integer4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
937 #define ffetarget_cmp_logical1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
938 #define ffetarget_cmp_logical2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
939 #define ffetarget_cmp_logical3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
940 #define ffetarget_cmp_logical4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
941 #define ffetarget_cmp_real1(l,r) memcmp (&(l), &(r), sizeof(l))
942 #define ffetarget_cmp_real2(l,r) memcmp (&(l), &(r), sizeof(l))
943 #define ffetarget_cmp_real3(l,r) memcmp (&(l), &(r), sizeof(l))
944 #define ffetarget_cmp_typeless(l,r) \
945 memcmp (&(l), &(r), sizeof ((l)))
946 #define ffetarget_convert_character1_integer1(res,res_size,l,pool) \
947 ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
948 #define ffetarget_convert_character1_integer2(res,res_size,l,pool) \
949 ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
950 #define ffetarget_convert_character1_integer3(res,res_size,l,pool) \
951 ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
952 #define ffetarget_convert_character1_logical1(res,res_size,l,pool) \
953 ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
954 #define ffetarget_convert_character1_logical2(res,res_size,l,pool) \
955 ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
956 #define ffetarget_convert_character1_logical3(res,res_size,l,pool) \
957 ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
958 #define ffetarget_convert_complex1_character1(res,l) \
959 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
960 #define ffetarget_convert_complex1_hollerith(res,l) \
961 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
962 #define ffetarget_convert_complex1_typeless(res,l) \
963 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
964 #ifdef REAL_ARITHMETIC
965 #define ffetarget_convert_complex1_complex2(res,l) \
966 ({ REAL_VALUE_TYPE lr, li; \
967 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
968 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
969 ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
970 ffetarget_cvt_rv_to_r1_ (li, (res)->imaginary), \
973 #define ffetarget_convert_complex1_complex2(res,l) \
974 ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
976 #ifdef REAL_ARITHMETIC
977 #define ffetarget_convert_complex1_integer(res,l) \
978 ({ REAL_VALUE_TYPE resi, resr; \
979 ffetargetInteger1 lf = (l); \
980 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
982 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
983 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
986 #define ffetarget_convert_complex1_integer(res,l) \
987 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
989 #define ffetarget_convert_complex1_integer1 ffetarget_convert_complex1_integer
990 #define ffetarget_convert_complex1_integer2 ffetarget_convert_complex1_integer
991 #define ffetarget_convert_complex1_integer3 ffetarget_convert_complex1_integer
992 #ifdef REAL_ARITHMETIC
993 #define ffetarget_convert_complex1_integer4(res,l) FFEBAD_NOCANDO
995 #define ffetarget_convert_complex1_integer4 ffetarget_convert_complex1_integer
997 #ifdef REAL_ARITHMETIC
998 #define ffetarget_convert_complex1_real1(res,l) \
999 ((res)->real = (l), \
1000 ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
1002 #define ffetarget_convert_complex1_real2(res,l) \
1003 ({ REAL_VALUE_TYPE lr; \
1004 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1005 ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
1006 ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
1009 #define ffetarget_convert_complex1_real1(res,l) \
1010 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1011 #define ffetarget_convert_complex1_real2(res,l) \
1012 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1014 #define ffetarget_convert_complex2_character1(res,l) \
1015 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1016 #define ffetarget_convert_complex2_hollerith(res,l) \
1017 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1018 #define ffetarget_convert_complex2_typeless(res,l) \
1019 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1020 #ifdef REAL_ARITHMETIC
1021 #define ffetarget_convert_complex2_complex1(res,l) \
1022 ({ REAL_VALUE_TYPE lr, li; \
1023 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1024 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1025 ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
1026 ffetarget_cvt_rv_to_r2_ (li, &((res)->imaginary.v[0])), \
1029 #define ffetarget_convert_complex2_complex1(res,l) \
1030 ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
1032 #ifdef REAL_ARITHMETIC
1033 #define ffetarget_convert_complex2_integer(res,l) \
1034 ({ REAL_VALUE_TYPE resi, resr; \
1035 ffetargetInteger1 lf = (l); \
1036 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
1038 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1039 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1042 #define ffetarget_convert_complex2_integer(res,l) \
1043 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1045 #define ffetarget_convert_complex2_integer1 ffetarget_convert_complex2_integer
1046 #define ffetarget_convert_complex2_integer2 ffetarget_convert_complex2_integer
1047 #define ffetarget_convert_complex2_integer3 ffetarget_convert_complex2_integer
1048 #ifdef REAL_ARITHMETIC
1049 #define ffetarget_convert_complex2_integer4(res,l) FFEBAD_NOCANDO
1051 #define ffetarget_convert_complex2_integer4 ffetarget_convert_complex2_integer
1053 #ifdef REAL_ARITHMETIC
1054 #define ffetarget_convert_complex2_real1(res,l) \
1055 ({ REAL_VALUE_TYPE lr; \
1056 lr = ffetarget_cvt_r1_to_rv_ (l); \
1057 ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
1058 ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
1060 #define ffetarget_convert_complex2_real2(res,l) \
1061 ((res)->real = (l), \
1062 ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
1065 #define ffetarget_convert_complex2_real1(res,l) \
1066 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1067 #define ffetarget_convert_complex2_real2(res,l) \
1068 ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
1070 #define ffetarget_convert_integer2_character1(res,l) \
1071 ffetarget_convert_integer1_character1(res,l)
1072 #define ffetarget_convert_integer2_complex1(res,l) \
1073 ffetarget_convert_integer1_complex1(res,l)
1074 #define ffetarget_convert_integer2_complex2(res,l) \
1075 ffetarget_convert_integer1_complex2(res,l)
1076 #define ffetarget_convert_integer2_hollerith(res,l) \
1077 ffetarget_convert_integer1_hollerith(res,l)
1078 #define ffetarget_convert_integer2_integer1(res,l) (*(res) = (l), FFEBAD)
1079 #define ffetarget_convert_integer2_integer3(res,l) (*(res) = (l), FFEBAD)
1080 #define ffetarget_convert_integer2_integer4(res,l) (*(res) = (l), FFEBAD)
1081 #define ffetarget_convert_integer2_logical1(res,l) \
1082 ffetarget_convert_integer1_logical1(res,l)
1083 #define ffetarget_convert_integer2_logical2(res,l) \
1084 ffetarget_convert_integer2_logical1(res,l)
1085 #define ffetarget_convert_integer2_logical3(res,l) \
1086 ffetarget_convert_integer2_logical1(res,l)
1087 #define ffetarget_convert_integer2_logical4(res,l) \
1088 ffetarget_convert_integer2_logical1(res,l)
1089 #define ffetarget_convert_integer2_real1(res,l) \
1090 ffetarget_convert_integer1_real1(res,l)
1091 #define ffetarget_convert_integer2_real2(res,l) \
1092 ffetarget_convert_integer1_real2(res,l)
1093 #define ffetarget_convert_integer2_typeless(res,l) \
1094 ffetarget_convert_integer1_typeless(res,l)
1095 #define ffetarget_convert_integer3_character1(res,l) \
1096 ffetarget_convert_integer1_character1(res,l)
1097 #define ffetarget_convert_integer3_complex1(res,l) \
1098 ffetarget_convert_integer1_complex1(res,l)
1099 #define ffetarget_convert_integer3_complex2(res,l) \
1100 ffetarget_convert_integer1_complex2(res,l)
1101 #define ffetarget_convert_integer3_hollerith(res,l) \
1102 ffetarget_convert_integer1_hollerith(res,l)
1103 #define ffetarget_convert_integer3_integer1(res,l) (*(res) = (l), FFEBAD)
1104 #define ffetarget_convert_integer3_integer2(res,l) (*(res) = (l), FFEBAD)
1105 #define ffetarget_convert_integer3_integer4(res,l) (*(res) = (l), FFEBAD)
1106 #define ffetarget_convert_integer3_logical1(res,l) \
1107 ffetarget_convert_integer1_logical1(res,l)
1108 #define ffetarget_convert_integer3_logical2(res,l) \
1109 ffetarget_convert_integer3_logical1(res,l)
1110 #define ffetarget_convert_integer3_logical3(res,l) \
1111 ffetarget_convert_integer3_logical1(res,l)
1112 #define ffetarget_convert_integer3_logical4(res,l) \
1113 ffetarget_convert_integer3_logical1(res,l)
1114 #define ffetarget_convert_integer3_real1(res,l) \
1115 ffetarget_convert_integer1_real1(res,l)
1116 #define ffetarget_convert_integer3_real2(res,l) \
1117 ffetarget_convert_integer1_real2(res,l)
1118 #define ffetarget_convert_integer3_typeless(res,l) \
1119 ffetarget_convert_integer1_typeless(res,l)
1120 #define ffetarget_convert_integer4_character1(res,l) \
1121 ffetarget_convert_integer1_character1(res,l)
1122 #ifdef REAL_ARITHMETIC
1123 #define ffetarget_convert_integer4_complex1(res,l) FFEBAD_NOCANDO
1124 #define ffetarget_convert_integer4_complex2(res,l) FFEBAD_NOCANDO
1126 #define ffetarget_convert_integer4_complex1(res,l) \
1127 ffetarget_convert_integer1_complex1(res,l)
1128 #define ffetarget_convert_integer4_complex2(res,l) \
1129 ffetarget_convert_integer1_complex2(res,l)
1131 #define ffetarget_convert_integer4_hollerith(res,l) \
1132 ffetarget_convert_integer1_hollerith(res,l)
1133 #define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD)
1134 #define ffetarget_convert_integer4_integer2(res,l) (*(res) = (l), FFEBAD)
1135 #define ffetarget_convert_integer4_integer3(res,l) (*(res) = (l), FFEBAD)
1136 #define ffetarget_convert_integer4_logical1(res,l) \
1137 ffetarget_convert_integer1_logical1(res,l)
1138 #define ffetarget_convert_integer4_logical2(res,l) \
1139 ffetarget_convert_integer1_logical1(res,l)
1140 #define ffetarget_convert_integer4_logical3(res,l) \
1141 ffetarget_convert_integer1_logical1(res,l)
1142 #define ffetarget_convert_integer4_logical4(res,l) \
1143 ffetarget_convert_integer1_logical1(res,l)
1144 #ifdef REAL_ARITHMETIC
1145 #define ffetarget_convert_integer4_real1(res,l) FFEBAD_NOCANDO
1146 #define ffetarget_convert_integer4_real2(res,l) FFEBAD_NOCANDO
1148 #define ffetarget_convert_integer4_real1(res,l) \
1149 ffetarget_convert_integer1_real1(res,l)
1150 #define ffetarget_convert_integer4_real2(res,l) \
1151 ffetarget_convert_integer1_real2(res,l)
1153 #define ffetarget_convert_integer4_typeless(res,l) \
1154 ffetarget_convert_integer1_typeless(res,l)
1155 #define ffetarget_convert_logical1_character1(res,l) \
1156 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1157 #define ffetarget_convert_logical1_hollerith(res,l) \
1158 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1159 #define ffetarget_convert_logical1_typeless(res,l) \
1160 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1161 #define ffetarget_convert_logical1_logical2(res,l) (*(res) = (l), FFEBAD)
1162 #define ffetarget_convert_logical1_logical3(res,l) (*(res) = (l), FFEBAD)
1163 #define ffetarget_convert_logical1_logical4(res,l) (*(res) = (l), FFEBAD)
1164 #define ffetarget_convert_logical1_integer1(res,l) (*(res) = (l), FFEBAD)
1165 #define ffetarget_convert_logical1_integer2(res,l) (*(res) = (l), FFEBAD)
1166 #define ffetarget_convert_logical1_integer3(res,l) (*(res) = (l), FFEBAD)
1167 #define ffetarget_convert_logical1_integer4(res,l) (*(res) = (l), FFEBAD)
1168 #define ffetarget_convert_logical2_character1(res,l) \
1169 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1170 #define ffetarget_convert_logical2_hollerith(res,l) \
1171 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1172 #define ffetarget_convert_logical2_typeless(res,l) \
1173 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1174 #define ffetarget_convert_logical2_logical1(res,l) (*(res) = (l), FFEBAD)
1175 #define ffetarget_convert_logical2_logical3(res,l) (*(res) = (l), FFEBAD)
1176 #define ffetarget_convert_logical2_logical4(res,l) (*(res) = (l), FFEBAD)
1177 #define ffetarget_convert_logical2_integer1(res,l) (*(res) = (l), FFEBAD)
1178 #define ffetarget_convert_logical2_integer2(res,l) (*(res) = (l), FFEBAD)
1179 #define ffetarget_convert_logical2_integer3(res,l) (*(res) = (l), FFEBAD)
1180 #define ffetarget_convert_logical2_integer4(res,l) (*(res) = (l), FFEBAD)
1181 #define ffetarget_convert_logical3_character1(res,l) \
1182 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1183 #define ffetarget_convert_logical3_hollerith(res,l) \
1184 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1185 #define ffetarget_convert_logical3_typeless(res,l) \
1186 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1187 #define ffetarget_convert_logical3_logical1(res,l) (*(res) = (l), FFEBAD)
1188 #define ffetarget_convert_logical3_logical2(res,l) (*(res) = (l), FFEBAD)
1189 #define ffetarget_convert_logical3_logical4(res,l) (*(res) = (l), FFEBAD)
1190 #define ffetarget_convert_logical3_integer1(res,l) (*(res) = (l), FFEBAD)
1191 #define ffetarget_convert_logical3_integer2(res,l) (*(res) = (l), FFEBAD)
1192 #define ffetarget_convert_logical3_integer3(res,l) (*(res) = (l), FFEBAD)
1193 #define ffetarget_convert_logical3_integer4(res,l) (*(res) = (l), FFEBAD)
1194 #define ffetarget_convert_logical4_character1(res,l) \
1195 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1196 #define ffetarget_convert_logical4_hollerith(res,l) \
1197 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1198 #define ffetarget_convert_logical4_typeless(res,l) \
1199 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1200 #define ffetarget_convert_logical4_logical1(res,l) (*(res) = (l), FFEBAD)
1201 #define ffetarget_convert_logical4_logical2(res,l) (*(res) = (l), FFEBAD)
1202 #define ffetarget_convert_logical4_logical3(res,l) (*(res) = (l), FFEBAD)
1203 #define ffetarget_convert_logical4_integer1(res,l) (*(res) = (l), FFEBAD)
1204 #define ffetarget_convert_logical4_integer2(res,l) (*(res) = (l), FFEBAD)
1205 #define ffetarget_convert_logical4_integer3(res,l) (*(res) = (l), FFEBAD)
1206 #define ffetarget_convert_logical4_integer4(res,l) (*(res) = (l), FFEBAD)
1207 #define ffetarget_convert_integer1_character1(res,l) \
1208 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1209 #define ffetarget_convert_integer1_hollerith(res,l) \
1210 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1211 #define ffetarget_convert_integer1_typeless(res,l) \
1212 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1213 #define ffetarget_convert_integer1_integer2(res,l) (*(res) = (l), FFEBAD)
1214 #define ffetarget_convert_integer1_integer3(res,l) (*(res) = (l), FFEBAD)
1215 #define ffetarget_convert_integer1_integer4(res,l) (*(res) = (l), FFEBAD)
1216 #define ffetarget_convert_integer1_logical1(res,l) (*(res) = (l), FFEBAD)
1217 #define ffetarget_convert_integer1_logical2(res,l) (*(res) = (l), FFEBAD)
1218 #define ffetarget_convert_integer1_logical3(res,l) (*(res) = (l), FFEBAD)
1219 #define ffetarget_convert_integer1_logical4(res,l) (*(res) = (l), FFEBAD)
1220 #ifdef REAL_ARITHMETIC
1221 #define ffetarget_convert_integer1_real1(res,l) \
1222 ({ REAL_VALUE_TYPE lr; \
1223 lr = ffetarget_cvt_r1_to_rv_ (l); \
1224 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1225 *(res) = ffetarget_long_val_; \
1227 #define ffetarget_convert_integer1_real2(res,l) \
1228 ({ REAL_VALUE_TYPE lr; \
1229 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1230 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1231 *(res) = ffetarget_long_val_; \
1233 #define ffetarget_convert_integer1_complex1(res,l) \
1234 ({ REAL_VALUE_TYPE lr; \
1235 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1236 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1237 *(res) = ffetarget_long_val_; \
1239 #define ffetarget_convert_integer1_complex2(res,l) \
1240 ({ REAL_VALUE_TYPE lr; \
1241 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1242 REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
1243 *(res) = ffetarget_long_val_; \
1246 #define ffetarget_convert_integer1_real1(res,l) (*(res) = (l), FFEBAD)
1247 #define ffetarget_convert_integer1_real2(res,l) (*(res) = (l), FFEBAD)
1248 #define ffetarget_convert_integer1_complex1(res,l) (*(res) = (l).real, FFEBAD)
1249 #define ffetarget_convert_integer1_complex2(res,l) (*(res) = (l).real, FFEBAD)
1251 #define ffetarget_convert_real1_character1(res,l) \
1252 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1253 #define ffetarget_convert_real1_hollerith(res,l) \
1254 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1255 #define ffetarget_convert_real1_integer2(res,l) \
1256 ffetarget_convert_real1_integer1(res,l)
1257 #define ffetarget_convert_real1_integer3(res,l) \
1258 ffetarget_convert_real1_integer1(res,l)
1259 #ifdef REAL_ARITHMETIC
1260 #define ffetarget_convert_real1_integer4(res,l) FFEBAD_NOCANDO
1262 #define ffetarget_convert_real1_integer4(res,l) \
1263 ffetarget_convert_real1_integer1(res,l)
1265 #define ffetarget_convert_real1_typeless(res,l) \
1266 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1267 #define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD)
1268 #define ffetarget_convert_real1_complex2(res,l) \
1269 ffetarget_convert_real1_real2 ((res), (l).real)
1270 #ifdef REAL_ARITHMETIC
1271 #define ffetarget_convert_real1_integer1(res,l) \
1272 ({ REAL_VALUE_TYPE resr; \
1273 ffetargetInteger1 lf = (l); \
1274 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
1275 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1278 #define ffetarget_convert_real1_integer1(res,l) (*(res) = (l), FFEBAD)
1280 #ifdef REAL_ARITHMETIC
1281 #define ffetarget_convert_real1_real2(res,l) \
1282 ({ REAL_VALUE_TYPE lr; \
1283 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1284 ffetarget_cvt_rv_to_r1_ (lr, *(res)); \
1287 #define ffetarget_convert_real1_real2(res,l) (*(res) = (l), FFEBAD)
1289 #define ffetarget_convert_real2_character1(res,l) \
1290 ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
1291 #define ffetarget_convert_real2_hollerith(res,l) \
1292 ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
1293 #define ffetarget_convert_real2_integer2(res,l) \
1294 ffetarget_convert_real2_integer1(res,l)
1295 #define ffetarget_convert_real2_integer3(res,l) \
1296 ffetarget_convert_real2_integer1(res,l)
1297 #ifdef REAL_ARITHMETIC
1298 #define ffetarget_convert_real2_integer4(res,l) FFEBAD_NOCANDO
1300 #define ffetarget_convert_real2_integer4(res,l) \
1301 ffetarget_convert_real2_integer1(res,l)
1303 #define ffetarget_convert_real2_typeless(res,l) \
1304 ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
1305 #define ffetarget_convert_real2_complex1(res,l) \
1306 ffetarget_convert_real2_real1 ((res), (l).real)
1307 #define ffetarget_convert_real2_complex2(res,l) (*(res) = (l).real, FFEBAD)
1308 #ifdef REAL_ARITHMETIC
1309 #define ffetarget_convert_real2_integer(res,l) \
1310 ({ REAL_VALUE_TYPE resr; \
1311 ffetargetInteger1 lf = (l); \
1312 FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
1313 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1315 #define ffetarget_convert_real2_integer1 ffetarget_convert_real2_integer
1317 #define ffetarget_convert_real2_integer1(res,l) (*(res) = (l), FFEBAD)
1319 #ifdef REAL_ARITHMETIC
1320 #define ffetarget_convert_real2_real1(res,l) \
1321 ({ REAL_VALUE_TYPE lr; \
1322 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1323 ffetarget_cvt_rv_to_r2_ (lr, &((res)->v[0])); \
1326 #define ffetarget_convert_real2_real1(res,l) (*(res) = (l), FFEBAD)
1328 #define ffetarget_divide_integer1(res,l,r) \
1329 (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
1330 : (*(res) = (l) / (r), FFEBAD))
1331 #define ffetarget_divide_integer2(res,l,r) \
1332 ffetarget_divide_integer1(res,l,r)
1333 #define ffetarget_divide_integer3(res,l,r) \
1334 ffetarget_divide_integer1(res,l,r)
1335 #define ffetarget_divide_integer4(res,l,r) \
1336 ffetarget_divide_integer1(res,l,r)
1337 #ifdef REAL_ARITHMETIC
1338 #define ffetarget_divide_real1(res,l,r) \
1339 ({ REAL_VALUE_TYPE lr, rr, resr; \
1340 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1341 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1342 REAL_VALUES_EQUAL (rr, dconst0) \
1343 ? ({ ffetarget_cvt_rv_to_r1_ (dconst0, *(res)); \
1344 FFEBAD_DIV_BY_ZERO; \
1346 : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
1347 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1351 #define ffetarget_divide_real2(res,l,r) \
1352 ({ REAL_VALUE_TYPE lr, rr, resr; \
1353 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1354 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1355 REAL_VALUES_EQUAL (rr, dconst0) \
1356 ? ({ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0])); \
1357 FFEBAD_DIV_BY_ZERO; \
1359 : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
1360 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1365 #define ffetarget_divide_real1(res,l,r) \
1366 (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
1367 : (*(res) = (l) / (r), FFEBAD))
1368 #define ffetarget_divide_real2(res,l,r) \
1369 (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
1370 : (*(res) = (l) / (r), FFEBAD))
1372 #ifdef REAL_ARITHMETIC
1373 #define ffetarget_eq_complex1(res,l,r) \
1374 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1375 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1376 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1377 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1378 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1379 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1382 #define ffetarget_eq_complex2(res,l,r) \
1383 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1384 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1385 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1386 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1387 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1388 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1392 #define ffetarget_eq_complex1(res,l,r) \
1393 (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \
1394 ? TRUE : FALSE, FFEBAD)
1395 #define ffetarget_eq_complex2(res,l,r) \
1396 (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \
1397 ? TRUE : FALSE, FFEBAD)
1399 #define ffetarget_eq_integer1(res,l,r) \
1400 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1401 #define ffetarget_eq_integer2(res,l,r) \
1402 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1403 #define ffetarget_eq_integer3(res,l,r) \
1404 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1405 #define ffetarget_eq_integer4(res,l,r) \
1406 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1407 #ifdef REAL_ARITHMETIC
1408 #define ffetarget_eq_real1(res,l,r) \
1409 ({ REAL_VALUE_TYPE lr, rr; \
1410 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1411 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1412 *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
1414 #define ffetarget_eq_real2(res,l,r) \
1415 ({ REAL_VALUE_TYPE lr, rr; \
1416 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1417 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1418 *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
1421 #define ffetarget_eq_real1(res,l,r) \
1422 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1423 #define ffetarget_eq_real2(res,l,r) \
1424 (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
1426 #define ffetarget_eqv_integer1(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1427 #define ffetarget_eqv_integer2(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1428 #define ffetarget_eqv_integer3(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1429 #define ffetarget_eqv_integer4(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
1430 #define ffetarget_eqv_logical1(res,l,r) (*(res) = (l) == (r), FFEBAD)
1431 #define ffetarget_eqv_logical2(res,l,r) (*(res) = (l) == (r), FFEBAD)
1432 #define ffetarget_eqv_logical3(res,l,r) (*(res) = (l) == (r), FFEBAD)
1433 #define ffetarget_eqv_logical4(res,l,r) (*(res) = (l) == (r), FFEBAD)
1434 #define ffetarget_ge_integer1(res,l,r) \
1435 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1436 #define ffetarget_ge_integer2(res,l,r) \
1437 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1438 #define ffetarget_ge_integer3(res,l,r) \
1439 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1440 #define ffetarget_ge_integer4(res,l,r) \
1441 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1442 #ifdef REAL_ARITHMETIC
1443 #define ffetarget_ge_real1(res,l,r) \
1444 ({ REAL_VALUE_TYPE lr, rr; \
1445 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1446 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1447 *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
1449 #define ffetarget_ge_real2(res,l,r) \
1450 ({ REAL_VALUE_TYPE lr, rr; \
1451 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1452 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1453 *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
1456 #define ffetarget_ge_real1(res,l,r) \
1457 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1458 #define ffetarget_ge_real2(res,l,r) \
1459 (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
1461 #define ffetarget_gt_integer1(res,l,r) \
1462 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1463 #define ffetarget_gt_integer2(res,l,r) \
1464 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1465 #define ffetarget_gt_integer3(res,l,r) \
1466 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1467 #define ffetarget_gt_integer4(res,l,r) \
1468 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1469 #ifdef REAL_ARITHMETIC
1470 #define ffetarget_gt_real1(res,l,r) \
1471 ({ REAL_VALUE_TYPE lr, rr; \
1472 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1473 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1474 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1477 #define ffetarget_gt_real2(res,l,r) \
1478 ({ REAL_VALUE_TYPE lr, rr; \
1479 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1480 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1481 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1485 #define ffetarget_gt_real1(res,l,r) \
1486 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1487 #define ffetarget_gt_real2(res,l,r) \
1488 (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
1490 #define ffetarget_hexxmil(v,t) ffetarget_typeless_hex (v, t)
1491 #define ffetarget_hexxvxt(v,t) ffetarget_typeless_hex (v, t)
1492 #define ffetarget_hexzmil(v,t) ffetarget_typeless_hex (v, t)
1493 #define ffetarget_hexzvxt(v,t) ffetarget_typeless_hex (v, t)
1494 #define ffetarget_init_0()
1495 #define ffetarget_init_1()
1496 #define ffetarget_init_2()
1497 #define ffetarget_init_3()
1498 #define ffetarget_init_4()
1499 #if !defined(__alpha__) && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__)))
1500 #define ffetarget_integerdefault_is_magical(i) \
1501 (((unsigned long int) i) == FFETARGET_integerBIG_MAGICAL)
1503 #define ffetarget_integerdefault_is_magical(i) \
1504 (((unsigned int) i) == FFETARGET_integerBIG_MAGICAL)
1506 #ifdef REAL_ARITHMETIC
1507 #define ffetarget_iszero_real1(l) \
1508 ({ REAL_VALUE_TYPE lr; \
1509 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1510 REAL_VALUES_EQUAL (lr, dconst0); \
1512 #define ffetarget_iszero_real2(l) \
1513 ({ REAL_VALUE_TYPE lr; \
1514 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1515 REAL_VALUES_EQUAL (lr, dconst0); \
1518 #define ffetarget_iszero_real1(l) ((l) == 0.)
1519 #define ffetarget_iszero_real2(l) ((l) == 0.)
1521 #define ffetarget_iszero_typeless(l) ((l) == 0)
1522 #define ffetarget_logical1(v,truth) (*(v) = truth ? 1 : 0)
1523 #define ffetarget_le_integer1(res,l,r) \
1524 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1525 #define ffetarget_le_integer2(res,l,r) \
1526 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1527 #define ffetarget_le_integer3(res,l,r) \
1528 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1529 #define ffetarget_le_integer4(res,l,r) \
1530 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1531 #ifdef REAL_ARITHMETIC
1532 #define ffetarget_le_real1(res,l,r) \
1533 ({ REAL_VALUE_TYPE lr, rr; \
1534 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1535 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1536 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1539 #define ffetarget_le_real2(res,l,r) \
1540 ({ REAL_VALUE_TYPE lr, rr; \
1541 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1542 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1543 *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
1547 #define ffetarget_le_real1(res,l,r) \
1548 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1549 #define ffetarget_le_real2(res,l,r) \
1550 (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
1552 #define ffetarget_lt_integer1(res,l,r) \
1553 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1554 #define ffetarget_lt_integer2(res,l,r) \
1555 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1556 #define ffetarget_lt_integer3(res,l,r) \
1557 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1558 #define ffetarget_lt_integer4(res,l,r) \
1559 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1560 #ifdef REAL_ARITHMETIC
1561 #define ffetarget_lt_real1(res,l,r) \
1562 ({ REAL_VALUE_TYPE lr, rr; \
1563 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1564 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1565 *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
1567 #define ffetarget_lt_real2(res,l,r) \
1568 ({ REAL_VALUE_TYPE lr, rr; \
1569 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1570 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1571 *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
1574 #define ffetarget_lt_real1(res,l,r) \
1575 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1576 #define ffetarget_lt_real2(res,l,r) \
1577 (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
1579 #define ffetarget_length_character1(c) ((c).length)
1580 #define ffetarget_length_characterdefault ffetarget_length_character1
1581 #ifdef REAL_ARITHMETIC
1582 #define ffetarget_make_real1(res,lr) \
1583 ffetarget_cvt_rv_to_r1_ ((lr), *(res))
1584 #define ffetarget_make_real2(res,lr) \
1585 ffetarget_cvt_rv_to_r2_ ((lr), &((res)->v[0]))
1587 #define ffetarget_make_real1(res,lr) (*(res) = (lr))
1588 #define ffetarget_make_real2(res,lr) (*(res) = (lr))
1590 #define ffetarget_multiply_integer1(res,l,r) (*(res) = (l) * (r), FFEBAD)
1591 #define ffetarget_multiply_integer2(res,l,r) (*(res) = (l) * (r), FFEBAD)
1592 #define ffetarget_multiply_integer3(res,l,r) (*(res) = (l) * (r), FFEBAD)
1593 #define ffetarget_multiply_integer4(res,l,r) (*(res) = (l) * (r), FFEBAD)
1594 #ifdef REAL_ARITHMETIC
1595 #define ffetarget_multiply_real1(res,l,r) \
1596 ({ REAL_VALUE_TYPE lr, rr, resr; \
1597 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1598 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1599 REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
1600 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1602 #define ffetarget_multiply_real2(res,l,r) \
1603 ({ REAL_VALUE_TYPE lr, rr, resr; \
1604 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1605 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1606 REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
1607 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1610 #define ffetarget_multiply_real1(res,l,r) (*(res) = (l) * (r), FFEBAD)
1611 #define ffetarget_multiply_real2(res,l,r) (*(res) = (l) * (r), FFEBAD)
1613 #ifdef REAL_ARITHMETIC
1614 #define ffetarget_ne_complex1(res,l,r) \
1615 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1616 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1617 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1618 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1619 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1620 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1623 #define ffetarget_ne_complex2(res,l,r) \
1624 ({ REAL_VALUE_TYPE lr, li, rr, ri; \
1625 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1626 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1627 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1628 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1629 *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
1633 #define ffetarget_ne_complex1(res,l,r) \
1634 (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \
1635 ? TRUE : FALSE, FFEBAD)
1636 #define ffetarget_ne_complex2(res,l,r) \
1637 (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \
1638 ? TRUE : FALSE, FFEBAD)
1640 #define ffetarget_ne_integer1(res,l,r) \
1641 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1642 #define ffetarget_ne_integer2(res,l,r) \
1643 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1644 #define ffetarget_ne_integer3(res,l,r) \
1645 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1646 #define ffetarget_ne_integer4(res,l,r) \
1647 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1648 #ifdef REAL_ARITHMETIC
1649 #define ffetarget_ne_real1(res,l,r) \
1650 ({ REAL_VALUE_TYPE lr, rr; \
1651 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1652 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1653 *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
1655 #define ffetarget_ne_real2(res,l,r) \
1656 ({ REAL_VALUE_TYPE lr, rr; \
1657 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1658 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1659 *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
1662 #define ffetarget_ne_real1(res,l,r) \
1663 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1664 #define ffetarget_ne_real2(res,l,r) \
1665 (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
1667 #define ffetarget_neqv_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1668 #define ffetarget_neqv_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1669 #define ffetarget_neqv_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1670 #define ffetarget_neqv_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1671 #define ffetarget_neqv_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
1672 #define ffetarget_neqv_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
1673 #define ffetarget_neqv_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
1674 #define ffetarget_neqv_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
1675 #define ffetarget_not_integer1(res,l) (*(res) = ~(l), FFEBAD)
1676 #define ffetarget_not_integer2(res,l) (*(res) = ~(l), FFEBAD)
1677 #define ffetarget_not_integer3(res,l) (*(res) = ~(l), FFEBAD)
1678 #define ffetarget_not_integer4(res,l) (*(res) = ~(l), FFEBAD)
1679 #define ffetarget_not_logical1(res,l) (*(res) = !(l), FFEBAD)
1680 #define ffetarget_not_logical2(res,l) (*(res) = !(l), FFEBAD)
1681 #define ffetarget_not_logical3(res,l) (*(res) = !(l), FFEBAD)
1682 #define ffetarget_not_logical4(res,l) (*(res) = !(l), FFEBAD)
1683 #define ffetarget_octalmil(v,t) ffetarget_typeless_octal (v, t)
1684 #define ffetarget_octalvxt(v,t) ffetarget_typeless_octal (v, t)
1685 #define ffetarget_offset(res,l) (*(res) = (l), TRUE) /* Overflow? */
1686 #define ffetarget_offset_add(res,l,r) (*(res) = (l) + (r), TRUE) /* Overflow? */
1687 #define ffetarget_offset_charsize(res,l,u) (*(res) = (l) * (u), TRUE) /* Ov? */
1688 #define ffetarget_offset_multiply(res,l,r) (*(res) = (l) * (r), TRUE) /* Ov? */
1689 #define ffetarget_offset_overflow(text) ((void) 0) /* ~~no message? */
1690 #define ffetarget_or_integer1(res,l,r) (*(res) = (l) | (r), FFEBAD)
1691 #define ffetarget_or_integer2(res,l,r) (*(res) = (l) | (r), FFEBAD)
1692 #define ffetarget_or_integer3(res,l,r) (*(res) = (l) | (r), FFEBAD)
1693 #define ffetarget_or_integer4(res,l,r) (*(res) = (l) | (r), FFEBAD)
1694 #define ffetarget_or_logical1(res,l,r) (*(res) = (l) || (r), FFEBAD)
1695 #define ffetarget_or_logical2(res,l,r) (*(res) = (l) || (r), FFEBAD)
1696 #define ffetarget_or_logical3(res,l,r) (*(res) = (l) || (r), FFEBAD)
1697 #define ffetarget_or_logical4(res,l,r) (*(res) = (l) || (r), FFEBAD)
1698 #define ffetarget_print_binarymil(f,v) ffetarget_print_binary (f, v)
1699 #define ffetarget_print_binaryvxt(f,v) ffetarget_print_binary (f, v)
1700 #define ffetarget_print_hexxmil(f,v) ffetarget_print_hex (f, v)
1701 #define ffetarget_print_hexxvxt(f,v) ffetarget_print_hex (f, v)
1702 #define ffetarget_print_hexzmil(f,v) ffetarget_print_hex (f, v)
1703 #define ffetarget_print_hexzvxt(f,v) ffetarget_print_hex (f, v)
1704 #define ffetarget_print_integer1(f,v) \
1705 fprintf ((f), "%" ffetargetInteger1_f "d", (v))
1706 #define ffetarget_print_integer2(f,v) \
1707 fprintf ((f), "%" ffetargetInteger2_f "d", (v))
1708 #define ffetarget_print_integer3(f,v) \
1709 fprintf ((f), "%" ffetargetInteger3_f "d", (v))
1710 #define ffetarget_print_integer4(f,v) \
1711 fprintf ((f), "%" ffetargetInteger4_f "d", (v))
1712 #define ffetarget_print_logical1(f,v) \
1713 fprintf ((f), "%" ffetargetLogical1_f "d", (v))
1714 #define ffetarget_print_logical2(f,v) \
1715 fprintf ((f), "%" ffetargetLogical2_f "d", (v))
1716 #define ffetarget_print_logical3(f,v) \
1717 fprintf ((f), "%" ffetargetLogical3_f "d", (v))
1718 #define ffetarget_print_logical4(f,v) \
1719 fprintf ((f), "%" ffetargetLogical4_f "d", (v))
1720 #define ffetarget_print_octalmil(f,v) ffetarget_print_octal(f,v)
1721 #define ffetarget_print_octalvxt(f,v) ffetarget_print_octal(f,v)
1722 #ifdef REAL_ARITHMETIC
1723 #define ffetarget_print_real1(f,l) \
1724 ({ REAL_VALUE_TYPE lr; \
1725 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1726 REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
1727 fputs (ffetarget_string_, (f)); \
1729 #define ffetarget_print_real2(f,l) \
1730 ({ REAL_VALUE_TYPE lr; \
1731 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1732 REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
1733 fputs (ffetarget_string_, (f)); \
1736 #define ffetarget_print_real1(f,v) \
1737 fprintf ((f), "%" ffetargetReal1_f "g", (v))
1738 #define ffetarget_print_real2(f,v) \
1739 fprintf ((f), "%" ffetargetReal2_f "g", (v))
1741 #ifdef REAL_ARITHMETIC
1742 #define ffetarget_real1_one(res) ffetarget_cvt_rv_to_r1_ (dconst1, *(res))
1743 #define ffetarget_real2_one(res) ffetarget_cvt_rv_to_r2_ (dconst1, &((res)->v[0]))
1745 #define ffetarget_real1_one(res) (*(res) = (float) 1.)
1746 #define ffetarget_real2_one(res) (*(res) = 1.)
1748 #ifdef REAL_ARITHMETIC
1749 #define ffetarget_real1_two(res) ffetarget_cvt_rv_to_r1_ (dconst2, *(res))
1750 #define ffetarget_real2_two(res) ffetarget_cvt_rv_to_r2_ (dconst2, &((res)->v[0]))
1752 #define ffetarget_real1_two(res) (*(res) = (float) 2.)
1753 #define ffetarget_real2_two(res) (*(res) = 2.)
1755 #ifdef REAL_ARITHMETIC
1756 #define ffetarget_real1_zero(res) ffetarget_cvt_rv_to_r1_ (dconst0, *(res))
1757 #define ffetarget_real2_zero(res) ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0]))
1759 #define ffetarget_real1_zero(res) (*(res) = (float) 0.)
1760 #define ffetarget_real2_zero(res) (*(res) = 0.)
1762 #define ffetarget_size_typeless_binary(t) ((ffetarget_num_digits_(t) + 7) / 8)
1763 #define ffetarget_size_typeless_octal(t) \
1764 ((ffetarget_num_digits_(t) * 3 + 7) / 8)
1765 #define ffetarget_size_typeless_hex(t) ((ffetarget_num_digits_(t) + 1) / 2)
1766 #ifdef REAL_ARITHMETIC
1767 #define ffetarget_subtract_complex1(res,l,r) \
1768 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
1769 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1770 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1771 rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
1772 ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
1773 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1774 REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
1775 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
1776 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
1778 #define ffetarget_subtract_complex2(res,l,r) \
1779 ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
1780 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1781 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1782 rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
1783 ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
1784 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1785 REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
1786 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1787 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1790 #define ffetarget_subtract_complex1(res,l,r) \
1791 ((res)->real = (l).real - (r).real, \
1792 (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
1793 #define ffetarget_subtract_complex2(res,l,r) \
1794 ((res)->real = (l).real - (r).real, \
1795 (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
1797 #define ffetarget_subtract_integer1(res,l,r) (*(res) = (l) - (r), FFEBAD)
1798 #define ffetarget_subtract_integer2(res,l,r) (*(res) = (l) - (r), FFEBAD)
1799 #define ffetarget_subtract_integer3(res,l,r) (*(res) = (l) - (r), FFEBAD)
1800 #define ffetarget_subtract_integer4(res,l,r) (*(res) = (l) - (r), FFEBAD)
1801 #ifdef REAL_ARITHMETIC
1802 #define ffetarget_subtract_real1(res,l,r) \
1803 ({ REAL_VALUE_TYPE lr, rr, resr; \
1804 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1805 rr = ffetarget_cvt_r1_to_rv_ ((r)); \
1806 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1807 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1809 #define ffetarget_subtract_real2(res,l,r) \
1810 ({ REAL_VALUE_TYPE lr, rr, resr; \
1811 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1812 rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
1813 REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
1814 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1817 #define ffetarget_subtract_real1(res,l,r) (*(res) = (l) - (r), FFEBAD)
1818 #define ffetarget_subtract_real2(res,l,r) (*(res) = (l) - (r), FFEBAD)
1820 #define ffetarget_terminate_0()
1821 #define ffetarget_terminate_1()
1822 #define ffetarget_terminate_2()
1823 #define ffetarget_terminate_3()
1824 #define ffetarget_terminate_4()
1825 #define ffetarget_text_character1(c) ((c).text)
1826 #define ffetarget_text_characterdefault ffetarget_text_character1
1827 #ifdef REAL_ARITHMETIC
1828 #define ffetarget_uminus_complex1(res,l) \
1829 ({ REAL_VALUE_TYPE lr, li, resr, resi; \
1830 lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
1831 li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
1832 resr = REAL_VALUE_NEGATE (lr); \
1833 resi = REAL_VALUE_NEGATE (li); \
1834 ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
1835 ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
1837 #define ffetarget_uminus_complex2(res,l) \
1838 ({ REAL_VALUE_TYPE lr, li, resr, resi; \
1839 lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
1840 li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
1841 resr = REAL_VALUE_NEGATE (lr); \
1842 resi = REAL_VALUE_NEGATE (li); \
1843 ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
1844 ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
1847 #define ffetarget_uminus_complex1(res,l) \
1848 ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
1849 #define ffetarget_uminus_complex2(res,l) \
1850 ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
1852 #define ffetarget_uminus_integer1(res,l) (*(res) = -(l), FFEBAD)
1853 #define ffetarget_uminus_integer2(res,l) (*(res) = -(l), FFEBAD)
1854 #define ffetarget_uminus_integer3(res,l) (*(res) = -(l), FFEBAD)
1855 #define ffetarget_uminus_integer4(res,l) (*(res) = -(l), FFEBAD)
1856 #ifdef REAL_ARITHMETIC
1857 #define ffetarget_uminus_real1(res,l) \
1858 ({ REAL_VALUE_TYPE lr, resr; \
1859 lr = ffetarget_cvt_r1_to_rv_ ((l)); \
1860 resr = REAL_VALUE_NEGATE (lr); \
1861 ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
1863 #define ffetarget_uminus_real2(res,l) \
1864 ({ REAL_VALUE_TYPE lr, resr; \
1865 lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
1866 resr = REAL_VALUE_NEGATE (lr); \
1867 ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
1870 #define ffetarget_uminus_real1(res,l) (*(res) = -(l), FFEBAD)
1871 #define ffetarget_uminus_real2(res,l) (*(res) = -(l), FFEBAD)
1873 #ifdef REAL_ARITHMETIC
1874 #define ffetarget_value_real1(lr) ffetarget_cvt_r1_to_rv_ ((lr))
1875 #define ffetarget_value_real2(lr) ffetarget_cvt_r2_to_rv_ (&((lr).v[0]))
1877 #define ffetarget_value_real1
1878 #define ffetarget_value_real2
1880 #define ffetarget_xor_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1881 #define ffetarget_xor_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1882 #define ffetarget_xor_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1883 #define ffetarget_xor_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
1884 #define ffetarget_xor_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
1885 #define ffetarget_xor_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
1886 #define ffetarget_xor_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
1887 #define ffetarget_xor_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
1889 /* End of #include file. */