]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/f/bld.c
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
PR c++/17413
[thirdparty/gcc.git] / gcc / f / bld.c
CommitLineData
8e5578ea 1/* bld.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995, 1996, 2003, 2004 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
4
5This file is part of GNU Fortran.
6
7GNU Fortran is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Fortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Fortran; see the file COPYING. If not, write to
19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
2002111-1307, USA.
21
22 Related Modules:
23 None
24
25 Description:
26 The primary "output" of the FFE includes ffebld objects, which
27 connect expressions, operators, and operands together, along with
28 connecting lists of expressions together for argument or dimension
29 lists.
30
31 Modifications:
32 30-Aug-92 JCB 1.1
33 Change names of some things for consistency.
34*/
35
36/* Include files. */
37
38#include "proj.h"
39#include "bld.h"
40#include "bit.h"
41#include "info.h"
42#include "lex.h"
43#include "malloc.h"
44#include "target.h"
45#include "where.h"
46#include "real.h"
47
48/* Externals defined here. */
49
50const ffebldArity ffebld_arity_op_[(int) FFEBLD_op]
51=
52{
53#define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
54#include "bld-op.def"
55#undef FFEBLD_OP
56};
57struct _ffebld_pool_stack_ ffebld_pool_stack_;
58
59/* Simple definitions and enumerations. */
60
61
62/* Internal typedefs. */
63
64
65/* Private include files. */
66
67
68/* Internal structure definitions. */
69
70
71/* Static objects accessed by functions in this module. */
72
73#if FFETARGET_okCHARACTER1
74static ffebldConstant ffebld_constant_character1_;
75#endif
76#if FFETARGET_okCOMPLEX1
77static ffebldConstant ffebld_constant_complex1_;
78#endif
79#if FFETARGET_okCOMPLEX2
80static ffebldConstant ffebld_constant_complex2_;
81#endif
82#if FFETARGET_okCOMPLEX3
83static ffebldConstant ffebld_constant_complex3_;
84#endif
85#if FFETARGET_okINTEGER1
86static ffebldConstant ffebld_constant_integer1_;
87#endif
88#if FFETARGET_okINTEGER2
89static ffebldConstant ffebld_constant_integer2_;
90#endif
91#if FFETARGET_okINTEGER3
92static ffebldConstant ffebld_constant_integer3_;
93#endif
94#if FFETARGET_okINTEGER4
95static ffebldConstant ffebld_constant_integer4_;
96#endif
97#if FFETARGET_okLOGICAL1
98static ffebldConstant ffebld_constant_logical1_;
99#endif
100#if FFETARGET_okLOGICAL2
101static ffebldConstant ffebld_constant_logical2_;
102#endif
103#if FFETARGET_okLOGICAL3
104static ffebldConstant ffebld_constant_logical3_;
105#endif
106#if FFETARGET_okLOGICAL4
107static ffebldConstant ffebld_constant_logical4_;
108#endif
109#if FFETARGET_okREAL1
110static ffebldConstant ffebld_constant_real1_;
111#endif
112#if FFETARGET_okREAL2
113static ffebldConstant ffebld_constant_real2_;
114#endif
115#if FFETARGET_okREAL3
116static ffebldConstant ffebld_constant_real3_;
117#endif
118static ffebldConstant ffebld_constant_hollerith_;
119static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
120 - FFEBLD_constTYPELESS_FIRST + 1];
121
122static const char *const ffebld_op_string_[]
123=
124{
125#define FFEBLD_OP(KWD,NAME,ARITY) NAME,
126#include "bld-op.def"
127#undef FFEBLD_OP
128};
129
130/* Static functions (internal). */
131
132
133/* Internal macros. */
134
135#define integerdefault_ CATX(integer,FFETARGET_ktINTEGERDEFAULT)
136#define logicaldefault_ CATX(logical,FFETARGET_ktLOGICALDEFAULT)
137#define realdefault_ CATX(real,FFETARGET_ktREALDEFAULT)
138#define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE)
139#define realquad_ CATX(real,FFETARGET_ktREALQUAD)
140\f
141/* ffebld_constant_cmp -- Compare two constants a la strcmp
142
143 ffebldConstant c1, c2;
144 if (ffebld_constant_cmp(c1,c2) == 0)
145 // they're equal, else they're not.
146
147 Returns -1 if c1 < c2, 0 if c1 == c2, +1 if c1 == c2. */
148
149int
150ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2)
151{
152 if (c1 == c2)
153 return 0;
154
155 assert (ffebld_constant_type (c1) == ffebld_constant_type (c2));
156
157 switch (ffebld_constant_type (c1))
158 {
159#if FFETARGET_okINTEGER1
160 case FFEBLD_constINTEGER1:
161 return ffetarget_cmp_integer1 (ffebld_constant_integer1 (c1),
162 ffebld_constant_integer1 (c2));
163#endif
164
165#if FFETARGET_okINTEGER2
166 case FFEBLD_constINTEGER2:
167 return ffetarget_cmp_integer2 (ffebld_constant_integer2 (c1),
168 ffebld_constant_integer2 (c2));
169#endif
170
171#if FFETARGET_okINTEGER3
172 case FFEBLD_constINTEGER3:
173 return ffetarget_cmp_integer3 (ffebld_constant_integer3 (c1),
174 ffebld_constant_integer3 (c2));
175#endif
176
177#if FFETARGET_okINTEGER4
178 case FFEBLD_constINTEGER4:
179 return ffetarget_cmp_integer4 (ffebld_constant_integer4 (c1),
180 ffebld_constant_integer4 (c2));
181#endif
182
183#if FFETARGET_okLOGICAL1
184 case FFEBLD_constLOGICAL1:
185 return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
186 ffebld_constant_logical1 (c2));
187#endif
188
189#if FFETARGET_okLOGICAL2
190 case FFEBLD_constLOGICAL2:
191 return ffetarget_cmp_logical2 (ffebld_constant_logical2 (c1),
192 ffebld_constant_logical2 (c2));
193#endif
194
195#if FFETARGET_okLOGICAL3
196 case FFEBLD_constLOGICAL3:
197 return ffetarget_cmp_logical3 (ffebld_constant_logical3 (c1),
198 ffebld_constant_logical3 (c2));
199#endif
200
201#if FFETARGET_okLOGICAL4
202 case FFEBLD_constLOGICAL4:
203 return ffetarget_cmp_logical4 (ffebld_constant_logical4 (c1),
204 ffebld_constant_logical4 (c2));
205#endif
206
207#if FFETARGET_okREAL1
208 case FFEBLD_constREAL1:
209 return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
210 ffebld_constant_real1 (c2));
211#endif
212
213#if FFETARGET_okREAL2
214 case FFEBLD_constREAL2:
215 return ffetarget_cmp_real2 (ffebld_constant_real2 (c1),
216 ffebld_constant_real2 (c2));
217#endif
218
219#if FFETARGET_okREAL3
220 case FFEBLD_constREAL3:
221 return ffetarget_cmp_real3 (ffebld_constant_real3 (c1),
222 ffebld_constant_real3 (c2));
223#endif
224
225#if FFETARGET_okCHARACTER1
226 case FFEBLD_constCHARACTER1:
227 return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
228 ffebld_constant_character1 (c2));
229#endif
230
231 default:
232 assert ("bad constant type" == NULL);
233 return 0;
234 }
235}
236
237/* ffebld_constant_is_magical -- Determine if integer is "magical"
238
239 ffebldConstant c;
240 if (ffebld_constant_is_magical(c))
241 // it is 2**(n-1), where n is # bits in ffetargetIntegerDefault type
242 // (this test is important for 2's-complement machines only). */
243
244bool
245ffebld_constant_is_magical (ffebldConstant c)
246{
247 switch (ffebld_constant_type (c))
248 {
249 case FFEBLD_constINTEGERDEFAULT:
250 return ffetarget_integerdefault_is_magical (ffebld_constant_integer1 (c));
251
252 default:
253 return FALSE;
254 }
255}
256
257/* Determine if constant is zero. Used to ensure step count
258 for DO loops isn't zero, also to determine if values will
259 be binary zeros, so not entirely portable at this point. */
260
261bool
262ffebld_constant_is_zero (ffebldConstant c)
263{
264 switch (ffebld_constant_type (c))
265 {
266#if FFETARGET_okINTEGER1
267 case FFEBLD_constINTEGER1:
268 return ffebld_constant_integer1 (c) == 0;
269#endif
270
271#if FFETARGET_okINTEGER2
272 case FFEBLD_constINTEGER2:
273 return ffebld_constant_integer2 (c) == 0;
274#endif
275
276#if FFETARGET_okINTEGER3
277 case FFEBLD_constINTEGER3:
278 return ffebld_constant_integer3 (c) == 0;
279#endif
280
281#if FFETARGET_okINTEGER4
282 case FFEBLD_constINTEGER4:
283 return ffebld_constant_integer4 (c) == 0;
284#endif
285
286#if FFETARGET_okLOGICAL1
287 case FFEBLD_constLOGICAL1:
288 return ffebld_constant_logical1 (c) == 0;
289#endif
290
291#if FFETARGET_okLOGICAL2
292 case FFEBLD_constLOGICAL2:
293 return ffebld_constant_logical2 (c) == 0;
294#endif
295
296#if FFETARGET_okLOGICAL3
297 case FFEBLD_constLOGICAL3:
298 return ffebld_constant_logical3 (c) == 0;
299#endif
300
301#if FFETARGET_okLOGICAL4
302 case FFEBLD_constLOGICAL4:
303 return ffebld_constant_logical4 (c) == 0;
304#endif
305
306#if FFETARGET_okREAL1
307 case FFEBLD_constREAL1:
308 return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
309#endif
310
311#if FFETARGET_okREAL2
312 case FFEBLD_constREAL2:
313 return ffetarget_iszero_real2 (ffebld_constant_real2 (c));
314#endif
315
316#if FFETARGET_okREAL3
317 case FFEBLD_constREAL3:
318 return ffetarget_iszero_real3 (ffebld_constant_real3 (c));
319#endif
320
321#if FFETARGET_okCOMPLEX1
322 case FFEBLD_constCOMPLEX1:
323 return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real)
324 && ffetarget_iszero_real1 (ffebld_constant_complex1 (c).imaginary);
325#endif
326
327#if FFETARGET_okCOMPLEX2
328 case FFEBLD_constCOMPLEX2:
329 return ffetarget_iszero_real2 (ffebld_constant_complex2 (c).real)
330 && ffetarget_iszero_real2 (ffebld_constant_complex2 (c).imaginary);
331#endif
332
333#if FFETARGET_okCOMPLEX3
334 case FFEBLD_constCOMPLEX3:
335 return ffetarget_iszero_real3 (ffebld_constant_complex3 (c).real)
336 && ffetarget_iszero_real3 (ffebld_constant_complex3 (c).imaginary);
337#endif
338
339#if FFETARGET_okCHARACTER1
340 case FFEBLD_constCHARACTER1:
341 return ffetarget_iszero_character1 (ffebld_constant_character1 (c));
342#endif
343
344 case FFEBLD_constHOLLERITH:
345 return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c));
346
347 case FFEBLD_constBINARY_MIL:
348 case FFEBLD_constBINARY_VXT:
349 case FFEBLD_constOCTAL_MIL:
350 case FFEBLD_constOCTAL_VXT:
351 case FFEBLD_constHEX_X_MIL:
352 case FFEBLD_constHEX_X_VXT:
353 case FFEBLD_constHEX_Z_MIL:
354 case FFEBLD_constHEX_Z_VXT:
355 return ffetarget_iszero_typeless (ffebld_constant_typeless (c));
356
357 default:
358 return FALSE;
359 }
360}
361
362/* ffebld_constant_new_character1 -- Return character1 constant object from token
363
364 See prototype. */
365
366#if FFETARGET_okCHARACTER1
367ffebldConstant
368ffebld_constant_new_character1 (ffelexToken t)
369{
370 ffetargetCharacter1 val;
371
372 ffetarget_character1 (&val, t, ffebld_constant_pool());
373 return ffebld_constant_new_character1_val (val);
374}
375
376#endif
377/* ffebld_constant_new_character1_val -- Return an character1 constant object
378
379 See prototype. */
380
381#if FFETARGET_okCHARACTER1
382ffebldConstant
383ffebld_constant_new_character1_val (ffetargetCharacter1 val)
384{
385 ffebldConstant nc;
386 ffebldConstant P;
387 ffebldConstant Q;
388 int cmp = 0;
389 P = ffebld_constant_character1_;
390 Q = P;
391 if (!P)
392 {
393 /* make this node the root */
394 nc = malloc_new_kp (ffebld_constant_pool(),
395 "FFEBLD_constCHARACTER1",
396 sizeof (*nc));
397 nc->consttype = FFEBLD_constCHARACTER1;
398 nc->u.character1 = val;
399 nc->hook = FFECOM_constantNULL;
400 nc->llink = NULL;
401 nc->rlink = NULL;
402 ffebld_constant_character1_ = nc;
403 return nc;
404 }
405 else
406 while (P)
407 {
408 Q = P;
409 cmp = ffetarget_cmp_character1 (val, ffebld_constant_character1 (P));
410 if (cmp > 0)
411 P = P->llink;
412 else if (cmp < 0)
413 P = P->rlink;
414 else
415 return P;
416 }
417
418 nc = malloc_new_kp (ffebld_constant_pool(),
419 "FFEBLD_constCHARACTER1",
420 sizeof (*nc));
421 nc->consttype = FFEBLD_constCHARACTER1;
422 nc->u.character1 = val;
423 nc->hook = FFECOM_constantNULL;
424 nc->llink = NULL;
425 nc->rlink = NULL;
426
427 if (cmp < 0)
428 Q->llink = nc;
429 else
430 Q->rlink = nc;
431 return nc;
432}
433
434#endif
435/* ffebld_constant_new_complex1 -- Return complex1 constant object from token
436
437 See prototype. */
438
439#if FFETARGET_okCOMPLEX1
440ffebldConstant
441ffebld_constant_new_complex1 (ffebldConstant real,
442 ffebldConstant imaginary)
443{
444 ffetargetComplex1 val;
445
446 val.real = ffebld_constant_real1 (real);
447 val.imaginary = ffebld_constant_real1 (imaginary);
448 return ffebld_constant_new_complex1_val (val);
449}
450
451#endif
452/* ffebld_constant_new_complex1_val -- Return a complex1 constant object
453
454 See prototype. */
455
456#if FFETARGET_okCOMPLEX1
457ffebldConstant
458ffebld_constant_new_complex1_val (ffetargetComplex1 val)
459{
460 ffebldConstant nc;
461 ffebldConstant P;
462 ffebldConstant Q;
463 int cmp = 0;
464 P = ffebld_constant_complex1_;
465 Q = P;
466 if (!P)
467 {
468 /* make this node the root */
469 nc = malloc_new_kp (ffebld_constant_pool(),
470 "FFEBLD_constCOMPLEX1",
471 sizeof (*nc));
472 nc->consttype = FFEBLD_constCOMPLEX1;
473 nc->u.complex1 = val;
474 nc->hook = FFECOM_constantNULL;
475 nc->llink = NULL;
476 nc->rlink = NULL;
477 ffebld_constant_complex1_ = nc;
478 return nc;
479 }
480 else
481 while (P)
482 {
483 Q = P;
484 cmp = ffetarget_cmp_real1 (val.real,
485 ffebld_constant_complex1 (P).real);
486 if (cmp == 0)
487 cmp = ffetarget_cmp_real1 (val.imaginary,
488 ffebld_constant_complex1 (P).imaginary);
489 if (cmp > 0)
490 P = P->llink;
491 else if (cmp < 0)
492 P = P->rlink;
493 else
494 return P;
495 }
496
497 nc = malloc_new_kp (ffebld_constant_pool(),
498 "FFEBLD_constCOMPLEX1",
499 sizeof (*nc));
500 nc->consttype = FFEBLD_constCOMPLEX1;
501 nc->u.complex1 = val;
502 nc->hook = FFECOM_constantNULL;
503 nc->llink = NULL;
504 nc->rlink = NULL;
505
506 if (cmp < 0)
507 Q->llink = nc;
508 else
509 Q->rlink = nc;
510 return nc;
511}
512
513#endif
514/* ffebld_constant_new_complex2 -- Return complex2 constant object from token
515
516 See prototype. */
517
518#if FFETARGET_okCOMPLEX2
519ffebldConstant
520ffebld_constant_new_complex2 (ffebldConstant real,
521 ffebldConstant imaginary)
522{
523 ffetargetComplex2 val;
524
525 val.real = ffebld_constant_real2 (real);
526 val.imaginary = ffebld_constant_real2 (imaginary);
527 return ffebld_constant_new_complex2_val (val);
528}
529
530#endif
531/* ffebld_constant_new_complex2_val -- Return a complex2 constant object
532
533 See prototype. */
534
535#if FFETARGET_okCOMPLEX2
536ffebldConstant
537ffebld_constant_new_complex2_val (ffetargetComplex2 val)
538{
539 ffebldConstant nc;
540 ffebldConstant P;
541 ffebldConstant Q;
542 int cmp = 0;
543 P = ffebld_constant_complex2_;
544 Q = P;
545 if (!P)
546 {
547 /* make this node the root */
548 nc = malloc_new_kp (ffebld_constant_pool(),
549 "FFEBLD_constCOMPLEX2",
550 sizeof (*nc));
551 nc->consttype = FFEBLD_constCOMPLEX2;
552 nc->u.complex2 = val;
553 nc->hook = FFECOM_constantNULL;
554 nc->llink = NULL;
555 nc->rlink = NULL;
556 ffebld_constant_complex2_ = nc;
557 return nc;
558 }
559 else
560 while (P)
561 {
562 Q = P;
563 cmp = ffetarget_cmp_real2 (val.real,
564 ffebld_constant_complex2 (P).real);
565 if (cmp == 0)
566 cmp = ffetarget_cmp_real2 (val.imaginary,
567 ffebld_constant_complex2 (P).imaginary);
568 if (cmp > 0)
569 P = P->llink;
570 else if (cmp < 0)
571 P = P->rlink;
572 else
573 return P;
574 }
575
576 nc = malloc_new_kp (ffebld_constant_pool(),
577 "FFEBLD_constCOMPLEX2",
578 sizeof (*nc));
579 nc->consttype = FFEBLD_constCOMPLEX2;
580 nc->u.complex2 = val;
581 nc->hook = FFECOM_constantNULL;
582 nc->llink = NULL;
583 nc->rlink = NULL;
584
585 if (cmp < 0)
586 Q->llink = nc;
587 else
588 Q->rlink = nc;
589 return nc;
590}
591
592#endif
593/* ffebld_constant_new_hollerith -- Return hollerith constant object from token
594
595 See prototype. */
596
597ffebldConstant
598ffebld_constant_new_hollerith (ffelexToken t)
599{
600 ffetargetHollerith val;
601
602 ffetarget_hollerith (&val, t, ffebld_constant_pool());
603 return ffebld_constant_new_hollerith_val (val);
604}
605
606/* ffebld_constant_new_hollerith_val -- Return an hollerith constant object
607
608 See prototype. */
609
610ffebldConstant
611ffebld_constant_new_hollerith_val (ffetargetHollerith val)
612{
613 ffebldConstant nc;
614 ffebldConstant P;
615 ffebldConstant Q;
616 int cmp = 0;
617 P = ffebld_constant_hollerith_;
618 Q = P;
619 if (!P)
620 {
621 /* make this node the root */
622 nc = malloc_new_kp (ffebld_constant_pool(),
623 "FFEBLD_constHOLLERITH",
624 sizeof (*nc));
625 nc->consttype = FFEBLD_constHOLLERITH;
626 nc->u.hollerith = val;
627 nc->hook = FFECOM_constantNULL;
628 nc->llink = NULL;
629 nc->rlink = NULL;
630 ffebld_constant_hollerith_ = nc;
631 return nc;
632 }
633 else
634 while (P)
635 {
636 Q = P;
637 cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (P));
638 if (cmp > 0)
639 P = P->llink;
640 else if (cmp < 0)
641 P = P->rlink;
642 else
643 return P;
644 }
645
646 nc = malloc_new_kp (ffebld_constant_pool(),
647 "FFEBLD_constHOLLERITH",
648 sizeof (*nc));
649 nc->consttype = FFEBLD_constHOLLERITH;
650 nc->u.hollerith = val;
651 nc->hook = FFECOM_constantNULL;
652 nc->llink = NULL;
653 nc->rlink = NULL;
654
655 if (cmp < 0)
656 Q->llink = nc;
657 else
658 Q->rlink = nc;
659 return nc;
660}
661
662/* ffebld_constant_new_integer1 -- Return integer1 constant object from token
663
664 See prototype.
665
666 Parses the token as a decimal integer constant, thus it must be an
667 FFELEX_typeNUMBER. */
668
669#if FFETARGET_okINTEGER1
670ffebldConstant
671ffebld_constant_new_integer1 (ffelexToken t)
672{
673 ffetargetInteger1 val;
674
675 assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
676
677 ffetarget_integer1 (&val, t);
678 return ffebld_constant_new_integer1_val (val);
679}
680
681#endif
682/* ffebld_constant_new_integer1_val -- Return an integer1 constant object
683
684 See prototype. */
685
686#if FFETARGET_okINTEGER1
687ffebldConstant
688ffebld_constant_new_integer1_val (ffetargetInteger1 val)
689{
690
691 ffebldConstant nc;
692 ffebldConstant P;
693 ffebldConstant Q;
694 int cmp = 0;
695 P = ffebld_constant_integer1_;
696 Q = P;
697 if (!P)
698 {
699 /* make this node the root */
700 nc = malloc_new_kp (ffebld_constant_pool(),
701 "FFEBLD_constINTEGER1",
702 sizeof (*nc));
703 nc->consttype = FFEBLD_constINTEGER1;
704 nc->u.integer1 = val;
705 nc->hook = FFECOM_constantNULL;
706 nc->llink = NULL;
707 nc->rlink = NULL;
708 ffebld_constant_integer1_ = nc;
709 return nc;
710 }
711 else
712 while (P)
713 {
714 Q = P;
715 cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (P));
716 if (cmp > 0)
717 P = P->llink;
718 else if (cmp < 0)
719 P = P->rlink;
720 else
721 return P;
722 }
723
724 nc = malloc_new_kp (ffebld_constant_pool(),
725 "FFEBLD_constINTEGER1",
726 sizeof (*nc));
727 nc->consttype = FFEBLD_constINTEGER1;
728 nc->u.integer1 = val;
729 nc->hook = FFECOM_constantNULL;
730 nc->llink = NULL;
731 nc->rlink = NULL;
732
733 if (cmp < 0)
734 Q->llink = nc;
735 else
736 Q->rlink = nc;
737 return nc;
738}
739
740#endif
741/* ffebld_constant_new_integer2_val -- Return an integer2 constant object
742
743 See prototype. */
744
745#if FFETARGET_okINTEGER2
746ffebldConstant
747ffebld_constant_new_integer2_val (ffetargetInteger2 val)
748{
749 ffebldConstant nc;
750 ffebldConstant P;
751 ffebldConstant Q;
752 int cmp = 0;
753 P = ffebld_constant_integer2_;
754 Q = P;
755 if (!P)
756 {
757 /* make this node the root */
758 nc = malloc_new_kp (ffebld_constant_pool(),
759 "FFEBLD_constINTEGER2",
760 sizeof (*nc));
761 nc->consttype = FFEBLD_constINTEGER2;
762 nc->u.integer2 = val;
763 nc->hook = FFECOM_constantNULL;
764 nc->llink = NULL;
765 nc->rlink = NULL;
766 ffebld_constant_integer2_ = nc;
767 return nc;
768 }
769 else
770 while (P)
771 {
772 Q = P;
773 cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (P));
774 if (cmp > 0)
775 P = P->llink;
776 else if (cmp < 0)
777 P = P->rlink;
778 else
779 return P;
780 }
781
782 nc = malloc_new_kp (ffebld_constant_pool(),
783 "FFEBLD_constINTEGER2",
784 sizeof (*nc));
785 nc->consttype = FFEBLD_constINTEGER2;
786 nc->u.integer2 = val;
787 nc->hook = FFECOM_constantNULL;
788 nc->llink = NULL;
789 nc->rlink = NULL;
790
791 if (cmp < 0)
792 Q->llink = nc;
793 else
794 Q->rlink = nc;
795 return nc;
796}
797
798#endif
799/* ffebld_constant_new_integer3_val -- Return an integer3 constant object
800
801 See prototype. */
802
803#if FFETARGET_okINTEGER3
804ffebldConstant
805ffebld_constant_new_integer3_val (ffetargetInteger3 val)
806{
807 ffebldConstant nc;
808 ffebldConstant P;
809 ffebldConstant Q;
810 int cmp = 0;
811 P = ffebld_constant_integer3_;
812 Q = P;
813 if (!P)
814 {
815 /* make this node the root */
816 nc = malloc_new_kp (ffebld_constant_pool(),
817 "FFEBLD_constINTEGER3",
818 sizeof (*nc));
819 nc->consttype = FFEBLD_constINTEGER3;
820 nc->u.integer3 = val;
821 nc->hook = FFECOM_constantNULL;
822 nc->llink = NULL;
823 nc->rlink = NULL;
824 ffebld_constant_integer3_ = nc;
825 return nc;
826 }
827 else
828 while (P)
829 {
830 Q = P;
831 cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (P));
832 if (cmp > 0)
833 P = P->llink;
834 else if (cmp < 0)
835 P = P->rlink;
836 else
837 return P;
838 }
839
840 nc = malloc_new_kp (ffebld_constant_pool(),
841 "FFEBLD_constINTEGER3",
842 sizeof (*nc));
843 nc->consttype = FFEBLD_constINTEGER3;
844 nc->u.integer3 = val;
845 nc->hook = FFECOM_constantNULL;
846 nc->llink = NULL;
847 nc->rlink = NULL;
848
849 if (cmp < 0)
850 Q->llink = nc;
851 else
852 Q->rlink = nc;
853 return nc;
854}
855
856#endif
857/* ffebld_constant_new_integer4_val -- Return an integer4 constant object
858
859 See prototype. */
860
861#if FFETARGET_okINTEGER4
862ffebldConstant
863ffebld_constant_new_integer4_val (ffetargetInteger4 val)
864{
865 ffebldConstant nc;
866 ffebldConstant P;
867 ffebldConstant Q;
868 int cmp = 0;
869 P = ffebld_constant_integer4_;
870 Q = P;
871 if (!P)
872 {
873 /* make this node the root */
874 nc = malloc_new_kp (ffebld_constant_pool(),
875 "FFEBLD_constINTEGER4",
876 sizeof (*nc));
877 nc->consttype = FFEBLD_constINTEGER4;
878 nc->u.integer4 = val;
879 nc->hook = FFECOM_constantNULL;
880 nc->llink = NULL;
881 nc->rlink = NULL;
882 ffebld_constant_integer4_ = nc;
883 return nc;
884 }
885 else
886 while (P)
887 {
888 Q = P;
889 cmp = ffetarget_cmp_integer4 (val, ffebld_constant_integer4 (P));
890 if (cmp > 0)
891 P = P->llink;
892 else if (cmp < 0)
893 P = P->rlink;
894 else
895 return P;
896 }
897
898 nc = malloc_new_kp (ffebld_constant_pool(),
899 "FFEBLD_constINTEGER4",
900 sizeof (*nc));
901 nc->consttype = FFEBLD_constINTEGER4;
902 nc->u.integer4 = val;
903 nc->hook = FFECOM_constantNULL;
904 nc->llink = NULL;
905 nc->rlink = NULL;
906
907 if (cmp < 0)
908 Q->llink = nc;
909 else
910 Q->rlink = nc;
911 return nc;
912}
913
914#endif
915/* ffebld_constant_new_integerbinary -- Return binary constant object from token
916
917 See prototype.
918
919 Parses the token as a binary integer constant, thus it must be an
920 FFELEX_typeNUMBER. */
921
922ffebldConstant
923ffebld_constant_new_integerbinary (ffelexToken t)
924{
925 ffetargetIntegerDefault val;
926
927 assert ((ffelex_token_type (t) == FFELEX_typeNAME)
928 || (ffelex_token_type (t) == FFELEX_typeNUMBER));
929
930 ffetarget_integerbinary (&val, t);
931 return ffebld_constant_new_integerdefault_val (val);
932}
933
934/* ffebld_constant_new_integerhex -- Return hex constant object from token
935
936 See prototype.
937
938 Parses the token as a hex integer constant, thus it must be an
939 FFELEX_typeNUMBER. */
940
941ffebldConstant
942ffebld_constant_new_integerhex (ffelexToken t)
943{
944 ffetargetIntegerDefault val;
945
946 assert ((ffelex_token_type (t) == FFELEX_typeNAME)
947 || (ffelex_token_type (t) == FFELEX_typeNUMBER));
948
949 ffetarget_integerhex (&val, t);
950 return ffebld_constant_new_integerdefault_val (val);
951}
952
953/* ffebld_constant_new_integeroctal -- Return octal constant object from token
954
955 See prototype.
956
957 Parses the token as a octal integer constant, thus it must be an
958 FFELEX_typeNUMBER. */
959
960ffebldConstant
961ffebld_constant_new_integeroctal (ffelexToken t)
962{
963 ffetargetIntegerDefault val;
964
965 assert ((ffelex_token_type (t) == FFELEX_typeNAME)
966 || (ffelex_token_type (t) == FFELEX_typeNUMBER));
967
968 ffetarget_integeroctal (&val, t);
969 return ffebld_constant_new_integerdefault_val (val);
970}
971
972/* ffebld_constant_new_logical1 -- Return logical1 constant object from token
973
974 See prototype.
975
976 Parses the token as a decimal logical constant, thus it must be an
977 FFELEX_typeNUMBER. */
978
979#if FFETARGET_okLOGICAL1
980ffebldConstant
981ffebld_constant_new_logical1 (bool truth)
982{
983 ffetargetLogical1 val;
984
985 ffetarget_logical1 (&val, truth);
986 return ffebld_constant_new_logical1_val (val);
987}
988
989#endif
990/* ffebld_constant_new_logical1_val -- Return a logical1 constant object
991
992 See prototype. */
993
994#if FFETARGET_okLOGICAL1
995ffebldConstant
996ffebld_constant_new_logical1_val (ffetargetLogical1 val)
997{
998 ffebldConstant nc;
999 ffebldConstant P;
1000 ffebldConstant Q;
1001 int cmp = 0;
1002 P = ffebld_constant_logical1_;
1003 Q = P;
1004 if (!P)
1005 {
1006 /* make this node the root */
1007 nc = malloc_new_kp (ffebld_constant_pool(),
1008 "FFEBLD_constLOGICAL1",
1009 sizeof (*nc));
1010 nc->consttype = FFEBLD_constLOGICAL1;
1011 nc->u.logical1 = val;
1012 nc->hook = FFECOM_constantNULL;
1013 nc->llink = NULL;
1014 nc->rlink = NULL;
1015 ffebld_constant_logical1_ = nc;
1016 return nc;
1017 }
1018 else
1019 while (P)
1020 {
1021 Q = P;
1022 cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (P));
1023 if (cmp > 0)
1024 P = P->llink;
1025 else if (cmp < 0)
1026 P = P->rlink;
1027 else
1028 return P;
1029 }
1030
1031 nc = malloc_new_kp (ffebld_constant_pool(),
1032 "FFEBLD_constLOGICAL1",
1033 sizeof (*nc));
1034 nc->consttype = FFEBLD_constLOGICAL1;
1035 nc->u.logical1 = val;
1036 nc->hook = FFECOM_constantNULL;
1037 nc->llink = NULL;
1038 nc->rlink = NULL;
1039
1040 if (cmp < 0)
1041 Q->llink = nc;
1042 else
1043 Q->rlink = nc;
1044 return nc;
1045}
1046
1047#endif
1048/* ffebld_constant_new_logical2_val -- Return a logical2 constant object
1049
1050 See prototype. */
1051
1052#if FFETARGET_okLOGICAL2
1053ffebldConstant
1054ffebld_constant_new_logical2_val (ffetargetLogical2 val)
1055{
1056 ffebldConstant nc;
1057 ffebldConstant P;
1058 ffebldConstant Q;
1059 int cmp = 0;
1060 P = ffebld_constant_logical2_;
1061 Q = P;
1062 if (!P)
1063 {
1064 /* make this node the root */
1065 nc = malloc_new_kp (ffebld_constant_pool(),
1066 "FFEBLD_constLOGICAL2",
1067 sizeof (*nc));
1068 nc->consttype = FFEBLD_constLOGICAL2;
1069 nc->u.logical2 = val;
1070 nc->hook = FFECOM_constantNULL;
1071 nc->llink = NULL;
1072 nc->rlink = NULL;
1073 ffebld_constant_logical2_ = nc;
1074 return nc;
1075 }
1076 else
1077 while (P)
1078 {
1079 Q = P;
1080 cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (P));
1081 if (cmp > 0)
1082 P = P->llink;
1083 else if (cmp < 0)
1084 P = P->rlink;
1085 else
1086 return P;
1087 }
1088
1089 nc = malloc_new_kp (ffebld_constant_pool(),
1090 "FFEBLD_constLOGICAL2",
1091 sizeof (*nc));
1092 nc->consttype = FFEBLD_constLOGICAL2;
1093 nc->u.logical2 = val;
1094 nc->hook = FFECOM_constantNULL;
1095 nc->llink = NULL;
1096 nc->rlink = NULL;
1097
1098 if (cmp < 0)
1099 Q->llink = nc;
1100 else
1101 Q->rlink = nc;
1102 return nc;
1103}
1104
1105#endif
1106/* ffebld_constant_new_logical3_val -- Return a logical3 constant object
1107
1108 See prototype. */
1109
1110#if FFETARGET_okLOGICAL3
1111ffebldConstant
1112ffebld_constant_new_logical3_val (ffetargetLogical3 val)
1113{
1114 ffebldConstant nc;
1115 ffebldConstant P;
1116 ffebldConstant Q;
1117 int cmp = 0;
1118 P = ffebld_constant_logical3_;
1119 Q = P;
1120 if (!P)
1121 {
1122 /* make this node the root */
1123 nc = malloc_new_kp (ffebld_constant_pool(),
1124 "FFEBLD_constLOGICAL3",
1125 sizeof (*nc));
1126 nc->consttype = FFEBLD_constLOGICAL3;
1127 nc->u.logical3 = val;
1128 nc->hook = FFECOM_constantNULL;
1129 nc->llink = NULL;
1130 nc->rlink = NULL;
1131 ffebld_constant_logical3_ = nc;
1132 return nc;
1133 }
1134 else
1135 while (P)
1136 {
1137 Q = P;
1138 cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (P));
1139 if (cmp > 0)
1140 P = P->llink;
1141 else if (cmp < 0)
1142 P = P->rlink;
1143 else
1144 return P;
1145 }
1146
1147 nc = malloc_new_kp (ffebld_constant_pool(),
1148 "FFEBLD_constLOGICAL3",
1149 sizeof (*nc));
1150 nc->consttype = FFEBLD_constLOGICAL3;
1151 nc->u.logical3 = val;
1152 nc->hook = FFECOM_constantNULL;
1153 nc->llink = NULL;
1154 nc->rlink = NULL;
1155
1156 if (cmp < 0)
1157 Q->llink = nc;
1158 else
1159 Q->rlink = nc;
1160 return nc;
1161}
1162
1163#endif
1164/* ffebld_constant_new_logical4_val -- Return a logical4 constant object
1165
1166 See prototype. */
1167
1168#if FFETARGET_okLOGICAL4
1169ffebldConstant
1170ffebld_constant_new_logical4_val (ffetargetLogical4 val)
1171{
1172 ffebldConstant nc;
1173 ffebldConstant P;
1174 ffebldConstant Q;
1175 int cmp = 0;
1176 P = ffebld_constant_logical4_;
1177 Q = P;
1178 if (!P)
1179 {
1180 /* make this node the root */
1181 nc = malloc_new_kp (ffebld_constant_pool(),
1182 "FFEBLD_constLOGICAL4",
1183 sizeof (*nc));
1184 nc->consttype = FFEBLD_constLOGICAL4;
1185 nc->u.logical4 = val;
1186 nc->hook = FFECOM_constantNULL;
1187 nc->llink = NULL;
1188 nc->rlink = NULL;
1189 ffebld_constant_logical4_ = nc;
1190 return nc;
1191 }
1192 else
1193 while (P)
1194 {
1195 Q = P;
1196 cmp = ffetarget_cmp_logical4 (val, ffebld_constant_logical4 (P));
1197 if (cmp > 0)
1198 P = P->llink;
1199 else if (cmp < 0)
1200 P = P->rlink;
1201 else
1202 return P;
1203 }
1204
1205 nc = malloc_new_kp (ffebld_constant_pool(),
1206 "FFEBLD_constLOGICAL4",
1207 sizeof (*nc));
1208 nc->consttype = FFEBLD_constLOGICAL4;
1209 nc->u.logical4 = val;
1210 nc->hook = FFECOM_constantNULL;
1211 nc->llink = NULL;
1212 nc->rlink = NULL;
1213
1214 if (cmp < 0)
1215 Q->llink = nc;
1216 else
1217 Q->rlink = nc;
1218 return nc;
1219}
1220
1221#endif
1222/* ffebld_constant_new_real1 -- Return real1 constant object from token
1223
1224 See prototype. */
1225
1226#if FFETARGET_okREAL1
1227ffebldConstant
1228ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal,
1229 ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
1230 ffelexToken exponent_digits)
1231{
1232 ffetargetReal1 val;
1233
1234 ffetarget_real1 (&val,
1235 integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
1236 return ffebld_constant_new_real1_val (val);
1237}
1238
1239#endif
1240/* ffebld_constant_new_real1_val -- Return an real1 constant object
1241
1242 See prototype. */
1243
1244#if FFETARGET_okREAL1
1245ffebldConstant
1246ffebld_constant_new_real1_val (ffetargetReal1 val)
1247{
1248 ffebldConstant nc;
1249 ffebldConstant P;
1250 ffebldConstant Q;
1251 int cmp = 0;
1252 P = ffebld_constant_real1_;
1253 Q = P;
1254 if (!P)
1255 {
1256 /* make this node the root */
1257 nc = malloc_new_kp (ffebld_constant_pool(),
1258 "FFEBLD_constREAL1",
1259 sizeof (*nc));
1260 nc->consttype = FFEBLD_constREAL1;
1261 nc->u.real1 = val;
1262 nc->hook = FFECOM_constantNULL;
1263 nc->llink = NULL;
1264 nc->rlink = NULL;
1265 ffebld_constant_real1_ = nc;
1266 return nc;
1267 }
1268 else
1269 while (P)
1270 {
1271 Q = P;
1272 cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (P));
1273 if (cmp > 0)
1274 P = P->llink;
1275 else if (cmp < 0)
1276 P = P->rlink;
1277 else
1278 return P;
1279 }
1280
1281 nc = malloc_new_kp (ffebld_constant_pool(),
1282 "FFEBLD_constREAL1",
1283 sizeof (*nc));
1284 nc->consttype = FFEBLD_constREAL1;
1285 nc->u.real1 = val;
1286 nc->hook = FFECOM_constantNULL;
1287 nc->llink = NULL;
1288 nc->rlink = NULL;
1289
1290 if (cmp < 0)
1291 Q->llink = nc;
1292 else
1293 Q->rlink = nc;
1294 return nc;
1295}
1296
1297#endif
1298/* ffebld_constant_new_real2 -- Return real2 constant object from token
1299
1300 See prototype. */
1301
1302#if FFETARGET_okREAL2
1303ffebldConstant
1304ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal,
1305 ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
1306 ffelexToken exponent_digits)
1307{
1308 ffetargetReal2 val;
1309
1310 ffetarget_real2 (&val,
1311 integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
1312 return ffebld_constant_new_real2_val (val);
1313}
1314
1315#endif
1316/* ffebld_constant_new_real2_val -- Return an real2 constant object
1317
1318 See prototype. */
1319
1320#if FFETARGET_okREAL2
1321ffebldConstant
1322ffebld_constant_new_real2_val (ffetargetReal2 val)
1323{
1324 ffebldConstant nc;
1325 ffebldConstant P;
1326 ffebldConstant Q;
1327 int cmp = 0;
1328 P = ffebld_constant_real2_;
1329 Q = P;
1330 if (!P)
1331 {
1332 /* make this node the root */
1333 nc = malloc_new_kp (ffebld_constant_pool(),
1334 "FFEBLD_constREAL2",
1335 sizeof (*nc));
1336 nc->consttype = FFEBLD_constREAL1;
1337 nc->u.real2 = val;
1338 nc->hook = FFECOM_constantNULL;
1339 nc->llink = NULL;
1340 nc->rlink = NULL;
1341 ffebld_constant_real2_ = nc;
1342 return nc;
1343 }
1344 else
1345 while (P)
1346 {
1347 Q = P;
1348 cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (P));
1349 if (cmp > 0)
1350 P = P->llink;
1351 else if (cmp < 0)
1352 P = P->rlink;
1353 else
1354 return P;
1355 }
1356
1357 nc = malloc_new_kp (ffebld_constant_pool(),
1358 "FFEBLD_constREAL2",
1359 sizeof (*nc));
1360 nc->consttype = FFEBLD_constREAL2;
1361 nc->u.real2 = val;
1362 nc->hook = FFECOM_constantNULL;
1363 nc->llink = NULL;
1364 nc->rlink = NULL;
1365
1366 if (cmp < 0)
1367 Q->llink = nc;
1368 else
1369 Q->rlink = nc;
1370 return nc;
1371}
1372
1373#endif
1374/* ffebld_constant_new_typeless_bm -- Return typeless constant object from token
1375
1376 See prototype.
1377
1378 Parses the token as a decimal integer constant, thus it must be an
1379 FFELEX_typeNUMBER. */
1380
1381ffebldConstant
1382ffebld_constant_new_typeless_bm (ffelexToken t)
1383{
1384 ffetargetTypeless val;
1385
1386 ffetarget_binarymil (&val, t);
1387 return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_MIL, val);
1388}
1389
1390/* ffebld_constant_new_typeless_bv -- Return typeless constant object from token
1391
1392 See prototype.
1393
1394 Parses the token as a decimal integer constant, thus it must be an
1395 FFELEX_typeNUMBER. */
1396
1397ffebldConstant
1398ffebld_constant_new_typeless_bv (ffelexToken t)
1399{
1400 ffetargetTypeless val;
1401
1402 ffetarget_binaryvxt (&val, t);
1403 return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_VXT, val);
1404}
1405
1406/* ffebld_constant_new_typeless_hxm -- Return typeless constant object from token
1407
1408 See prototype.
1409
1410 Parses the token as a decimal integer constant, thus it must be an
1411 FFELEX_typeNUMBER. */
1412
1413ffebldConstant
1414ffebld_constant_new_typeless_hxm (ffelexToken t)
1415{
1416 ffetargetTypeless val;
1417
1418 ffetarget_hexxmil (&val, t);
1419 return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_MIL, val);
1420}
1421
1422/* ffebld_constant_new_typeless_hxv -- Return typeless constant object from token
1423
1424 See prototype.
1425
1426 Parses the token as a decimal integer constant, thus it must be an
1427 FFELEX_typeNUMBER. */
1428
1429ffebldConstant
1430ffebld_constant_new_typeless_hxv (ffelexToken t)
1431{
1432 ffetargetTypeless val;
1433
1434 ffetarget_hexxvxt (&val, t);
1435 return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_VXT, val);
1436}
1437
1438/* ffebld_constant_new_typeless_hzm -- Return typeless constant object from token
1439
1440 See prototype.
1441
1442 Parses the token as a decimal integer constant, thus it must be an
1443 FFELEX_typeNUMBER. */
1444
1445ffebldConstant
1446ffebld_constant_new_typeless_hzm (ffelexToken t)
1447{
1448 ffetargetTypeless val;
1449
1450 ffetarget_hexzmil (&val, t);
1451 return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_MIL, val);
1452}
1453
1454/* ffebld_constant_new_typeless_hzv -- Return typeless constant object from token
1455
1456 See prototype.
1457
1458 Parses the token as a decimal integer constant, thus it must be an
1459 FFELEX_typeNUMBER. */
1460
1461ffebldConstant
1462ffebld_constant_new_typeless_hzv (ffelexToken t)
1463{
1464 ffetargetTypeless val;
1465
1466 ffetarget_hexzvxt (&val, t);
1467 return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_VXT, val);
1468}
1469
1470/* ffebld_constant_new_typeless_om -- Return typeless constant object from token
1471
1472 See prototype.
1473
1474 Parses the token as a decimal integer constant, thus it must be an
1475 FFELEX_typeNUMBER. */
1476
1477ffebldConstant
1478ffebld_constant_new_typeless_om (ffelexToken t)
1479{
1480 ffetargetTypeless val;
1481
1482 ffetarget_octalmil (&val, t);
1483 return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_MIL, val);
1484}
1485
1486/* ffebld_constant_new_typeless_ov -- Return typeless constant object from token
1487
1488 See prototype.
1489
1490 Parses the token as a decimal integer constant, thus it must be an
1491 FFELEX_typeNUMBER. */
1492
1493ffebldConstant
1494ffebld_constant_new_typeless_ov (ffelexToken t)
1495{
1496 ffetargetTypeless val;
1497
1498 ffetarget_octalvxt (&val, t);
1499 return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_VXT, val);
1500}
1501
1502/* ffebld_constant_new_typeless_val -- Return a typeless constant object
1503
1504 See prototype. */
1505
1506ffebldConstant
1507ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val)
1508{
1509
1510 ffebldConstant nc;
1511 ffebldConstant P;
1512 ffebldConstant Q;
1513 int cmp = 0;
1514 P = ffebld_constant_typeless_[type
1515 - FFEBLD_constTYPELESS_FIRST];
1516 Q = P;
1517 if (!P)
1518 {
1519 /* make this node the root */
1520 nc = malloc_new_kp (ffebld_constant_pool(),
1521 "FFEBLD_constTYPELESS",
1522 sizeof (*nc));
1523 nc->consttype = type;
1524 nc->u.typeless = val;
1525 nc->hook = FFECOM_constantNULL;
1526 nc->llink = NULL;
1527 nc->rlink = NULL;
1528 ffebld_constant_typeless_[type- FFEBLD_constTYPELESS_FIRST] = nc;
1529 return nc;
1530 }
1531 else
1532 while (P)
1533 {
1534 Q = P;
1535 cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (P));
1536 if (cmp > 0)
1537 P = P->llink;
1538 else if (cmp < 0)
1539 P = P->rlink;
1540 else
1541 return P;
1542 }
1543
1544 nc = malloc_new_kp (ffebld_constant_pool(),
1545 "FFEBLD_constTYPELESS",
1546 sizeof (*nc));
1547 nc->consttype = type;
1548 nc->u.typeless = val;
1549 nc->hook = FFECOM_constantNULL;
1550 nc->llink = NULL;
1551 nc->rlink = NULL;
1552
1553 if (cmp < 0)
1554 Q->llink = nc;
1555 else
1556 Q->rlink = nc;
1557 return nc;
1558}
1559
1560/* ffebld_constantarray_get -- Get a value from an array of constants
1561
1562 See prototype. */
1563
1564ffebldConstantUnion
1565ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
1566 ffeinfoKindtype kt, ffetargetOffset offset)
1567{
1568 ffebldConstantUnion u;
1569
1570 switch (bt)
1571 {
1572 case FFEINFO_basictypeINTEGER:
1573 switch (kt)
1574 {
1575#if FFETARGET_okINTEGER1
1576 case FFEINFO_kindtypeINTEGER1:
1577 u.integer1 = *(array.integer1 + offset);
1578 break;
1579#endif
1580
1581#if FFETARGET_okINTEGER2
1582 case FFEINFO_kindtypeINTEGER2:
1583 u.integer2 = *(array.integer2 + offset);
1584 break;
1585#endif
1586
1587#if FFETARGET_okINTEGER3
1588 case FFEINFO_kindtypeINTEGER3:
1589 u.integer3 = *(array.integer3 + offset);
1590 break;
1591#endif
1592
1593#if FFETARGET_okINTEGER4
1594 case FFEINFO_kindtypeINTEGER4:
1595 u.integer4 = *(array.integer4 + offset);
1596 break;
1597#endif
1598
1599 default:
1600 assert ("bad INTEGER kindtype" == NULL);
1601 break;
1602 }
1603 break;
1604
1605 case FFEINFO_basictypeLOGICAL:
1606 switch (kt)
1607 {
1608#if FFETARGET_okLOGICAL1
1609 case FFEINFO_kindtypeLOGICAL1:
1610 u.logical1 = *(array.logical1 + offset);
1611 break;
1612#endif
1613
1614#if FFETARGET_okLOGICAL2
1615 case FFEINFO_kindtypeLOGICAL2:
1616 u.logical2 = *(array.logical2 + offset);
1617 break;
1618#endif
1619
1620#if FFETARGET_okLOGICAL3
1621 case FFEINFO_kindtypeLOGICAL3:
1622 u.logical3 = *(array.logical3 + offset);
1623 break;
1624#endif
1625
1626#if FFETARGET_okLOGICAL4
1627 case FFEINFO_kindtypeLOGICAL4:
1628 u.logical4 = *(array.logical4 + offset);
1629 break;
1630#endif
1631
1632 default:
1633 assert ("bad LOGICAL kindtype" == NULL);
1634 break;
1635 }
1636 break;
1637
1638 case FFEINFO_basictypeREAL:
1639 switch (kt)
1640 {
1641#if FFETARGET_okREAL1
1642 case FFEINFO_kindtypeREAL1:
1643 u.real1 = *(array.real1 + offset);
1644 break;
1645#endif
1646
1647#if FFETARGET_okREAL2
1648 case FFEINFO_kindtypeREAL2:
1649 u.real2 = *(array.real2 + offset);
1650 break;
1651#endif
1652
1653#if FFETARGET_okREAL3
1654 case FFEINFO_kindtypeREAL3:
1655 u.real3 = *(array.real3 + offset);
1656 break;
1657#endif
1658
1659 default:
1660 assert ("bad REAL kindtype" == NULL);
1661 break;
1662 }
1663 break;
1664
1665 case FFEINFO_basictypeCOMPLEX:
1666 switch (kt)
1667 {
1668#if FFETARGET_okCOMPLEX1
1669 case FFEINFO_kindtypeREAL1:
1670 u.complex1 = *(array.complex1 + offset);
1671 break;
1672#endif
1673
1674#if FFETARGET_okCOMPLEX2
1675 case FFEINFO_kindtypeREAL2:
1676 u.complex2 = *(array.complex2 + offset);
1677 break;
1678#endif
1679
1680#if FFETARGET_okCOMPLEX3
1681 case FFEINFO_kindtypeREAL3:
1682 u.complex3 = *(array.complex3 + offset);
1683 break;
1684#endif
1685
1686 default:
1687 assert ("bad COMPLEX kindtype" == NULL);
1688 break;
1689 }
1690 break;
1691
1692 case FFEINFO_basictypeCHARACTER:
1693 switch (kt)
1694 {
1695#if FFETARGET_okCHARACTER1
1696 case FFEINFO_kindtypeCHARACTER1:
1697 u.character1.length = 1;
1698 u.character1.text = array.character1 + offset;
1699 break;
1700#endif
1701
1702 default:
1703 assert ("bad CHARACTER kindtype" == NULL);
1704 break;
1705 }
1706 break;
1707
1708 default:
1709 assert ("bad basictype" == NULL);
1710 break;
1711 }
1712
1713 return u;
1714}
1715
1716/* ffebld_constantarray_new -- Make an array of constants
1717
1718 See prototype. */
1719
1720ffebldConstantArray
1721ffebld_constantarray_new (ffeinfoBasictype bt,
1722 ffeinfoKindtype kt, ffetargetOffset size)
1723{
1724 ffebldConstantArray ptr;
1725
1726 switch (bt)
1727 {
1728 case FFEINFO_basictypeINTEGER:
1729 switch (kt)
1730 {
1731#if FFETARGET_okINTEGER1
1732 case FFEINFO_kindtypeINTEGER1:
1733 ptr.integer1 = malloc_new_zkp (ffebld_constant_pool(),
1734 "ffebldConstantArray",
1735 size *= sizeof (ffetargetInteger1),
1736 0);
1737 break;
1738#endif
1739
1740#if FFETARGET_okINTEGER2
1741 case FFEINFO_kindtypeINTEGER2:
1742 ptr.integer2 = malloc_new_zkp (ffebld_constant_pool(),
1743 "ffebldConstantArray",
1744 size *= sizeof (ffetargetInteger2),
1745 0);
1746 break;
1747#endif
1748
1749#if FFETARGET_okINTEGER3
1750 case FFEINFO_kindtypeINTEGER3:
1751 ptr.integer3 = malloc_new_zkp (ffebld_constant_pool(),
1752 "ffebldConstantArray",
1753 size *= sizeof (ffetargetInteger3),
1754 0);
1755 break;
1756#endif
1757
1758#if FFETARGET_okINTEGER4
1759 case FFEINFO_kindtypeINTEGER4:
1760 ptr.integer4 = malloc_new_zkp (ffebld_constant_pool(),
1761 "ffebldConstantArray",
1762 size *= sizeof (ffetargetInteger4),
1763 0);
1764 break;
1765#endif
1766
1767 default:
1768 assert ("bad INTEGER kindtype" == NULL);
1769 break;
1770 }
1771 break;
1772
1773 case FFEINFO_basictypeLOGICAL:
1774 switch (kt)
1775 {
1776#if FFETARGET_okLOGICAL1
1777 case FFEINFO_kindtypeLOGICAL1:
1778 ptr.logical1 = malloc_new_zkp (ffebld_constant_pool(),
1779 "ffebldConstantArray",
1780 size *= sizeof (ffetargetLogical1),
1781 0);
1782 break;
1783#endif
1784
1785#if FFETARGET_okLOGICAL2
1786 case FFEINFO_kindtypeLOGICAL2:
1787 ptr.logical2 = malloc_new_zkp (ffebld_constant_pool(),
1788 "ffebldConstantArray",
1789 size *= sizeof (ffetargetLogical2),
1790 0);
1791 break;
1792#endif
1793
1794#if FFETARGET_okLOGICAL3
1795 case FFEINFO_kindtypeLOGICAL3:
1796 ptr.logical3 = malloc_new_zkp (ffebld_constant_pool(),
1797 "ffebldConstantArray",
1798 size *= sizeof (ffetargetLogical3),
1799 0);
1800 break;
1801#endif
1802
1803#if FFETARGET_okLOGICAL4
1804 case FFEINFO_kindtypeLOGICAL4:
1805 ptr.logical4 = malloc_new_zkp (ffebld_constant_pool(),
1806 "ffebldConstantArray",
1807 size *= sizeof (ffetargetLogical4),
1808 0);
1809 break;
1810#endif
1811
1812 default:
1813 assert ("bad LOGICAL kindtype" == NULL);
1814 break;
1815 }
1816 break;
1817
1818 case FFEINFO_basictypeREAL:
1819 switch (kt)
1820 {
1821#if FFETARGET_okREAL1
1822 case FFEINFO_kindtypeREAL1:
1823 ptr.real1 = malloc_new_zkp (ffebld_constant_pool(),
1824 "ffebldConstantArray",
1825 size *= sizeof (ffetargetReal1),
1826 0);
1827 break;
1828#endif
1829
1830#if FFETARGET_okREAL2
1831 case FFEINFO_kindtypeREAL2:
1832 ptr.real2 = malloc_new_zkp (ffebld_constant_pool(),
1833 "ffebldConstantArray",
1834 size *= sizeof (ffetargetReal2),
1835 0);
1836 break;
1837#endif
1838
1839#if FFETARGET_okREAL3
1840 case FFEINFO_kindtypeREAL3:
1841 ptr.real3 = malloc_new_zkp (ffebld_constant_pool(),
1842 "ffebldConstantArray",
1843 size *= sizeof (ffetargetReal3),
1844 0);
1845 break;
1846#endif
1847
1848 default:
1849 assert ("bad REAL kindtype" == NULL);
1850 break;
1851 }
1852 break;
1853
1854 case FFEINFO_basictypeCOMPLEX:
1855 switch (kt)
1856 {
1857#if FFETARGET_okCOMPLEX1
1858 case FFEINFO_kindtypeREAL1:
1859 ptr.complex1 = malloc_new_zkp (ffebld_constant_pool(),
1860 "ffebldConstantArray",
1861 size *= sizeof (ffetargetComplex1),
1862 0);
1863 break;
1864#endif
1865
1866#if FFETARGET_okCOMPLEX2
1867 case FFEINFO_kindtypeREAL2:
1868 ptr.complex2 = malloc_new_zkp (ffebld_constant_pool(),
1869 "ffebldConstantArray",
1870 size *= sizeof (ffetargetComplex2),
1871 0);
1872 break;
1873#endif
1874
1875#if FFETARGET_okCOMPLEX3
1876 case FFEINFO_kindtypeREAL3:
1877 ptr.complex3 = malloc_new_zkp (ffebld_constant_pool(),
1878 "ffebldConstantArray",
1879 size *= sizeof (ffetargetComplex3),
1880 0);
1881 break;
1882#endif
1883
1884 default:
1885 assert ("bad COMPLEX kindtype" == NULL);
1886 break;
1887 }
1888 break;
1889
1890 case FFEINFO_basictypeCHARACTER:
1891 switch (kt)
1892 {
1893#if FFETARGET_okCHARACTER1
1894 case FFEINFO_kindtypeCHARACTER1:
1895 ptr.character1 = malloc_new_zkp (ffebld_constant_pool(),
1896 "ffebldConstantArray",
1897 size
1898 *= sizeof (ffetargetCharacterUnit1),
1899 0);
1900 break;
1901#endif
1902
1903 default:
1904 assert ("bad CHARACTER kindtype" == NULL);
1905 break;
1906 }
1907 break;
1908
1909 default:
1910 assert ("bad basictype" == NULL);
1911 break;
1912 }
1913
1914 return ptr;
1915}
1916
1917/* ffebld_constantarray_preparray -- Prepare for copy between arrays
1918
1919 See prototype.
1920
1921 Like _prepare, but the source is an array instead of a single-value
1922 constant. */
1923
1924void
1925ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
1926 ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
1927 ffetargetOffset offset, ffebldConstantArray source_array,
1928 ffeinfoBasictype cbt, ffeinfoKindtype ckt)
1929{
1930 switch (abt)
1931 {
1932 case FFEINFO_basictypeINTEGER:
1933 switch (akt)
1934 {
1935#if FFETARGET_okINTEGER1
1936 case FFEINFO_kindtypeINTEGER1:
1937 *aptr = array.integer1 + offset;
1938 break;
1939#endif
1940
1941#if FFETARGET_okINTEGER2
1942 case FFEINFO_kindtypeINTEGER2:
1943 *aptr = array.integer2 + offset;
1944 break;
1945#endif
1946
1947#if FFETARGET_okINTEGER3
1948 case FFEINFO_kindtypeINTEGER3:
1949 *aptr = array.integer3 + offset;
1950 break;
1951#endif
1952
1953#if FFETARGET_okINTEGER4
1954 case FFEINFO_kindtypeINTEGER4:
1955 *aptr = array.integer4 + offset;
1956 break;
1957#endif
1958
1959 default:
1960 assert ("bad INTEGER akindtype" == NULL);
1961 break;
1962 }
1963 break;
1964
1965 case FFEINFO_basictypeLOGICAL:
1966 switch (akt)
1967 {
1968#if FFETARGET_okLOGICAL1
1969 case FFEINFO_kindtypeLOGICAL1:
1970 *aptr = array.logical1 + offset;
1971 break;
1972#endif
1973
1974#if FFETARGET_okLOGICAL2
1975 case FFEINFO_kindtypeLOGICAL2:
1976 *aptr = array.logical2 + offset;
1977 break;
1978#endif
1979
1980#if FFETARGET_okLOGICAL3
1981 case FFEINFO_kindtypeLOGICAL3:
1982 *aptr = array.logical3 + offset;
1983 break;
1984#endif
1985
1986#if FFETARGET_okLOGICAL4
1987 case FFEINFO_kindtypeLOGICAL4:
1988 *aptr = array.logical4 + offset;
1989 break;
1990#endif
1991
1992 default:
1993 assert ("bad LOGICAL akindtype" == NULL);
1994 break;
1995 }
1996 break;
1997
1998 case FFEINFO_basictypeREAL:
1999 switch (akt)
2000 {
2001#if FFETARGET_okREAL1
2002 case FFEINFO_kindtypeREAL1:
2003 *aptr = array.real1 + offset;
2004 break;
2005#endif
2006
2007#if FFETARGET_okREAL2
2008 case FFEINFO_kindtypeREAL2:
2009 *aptr = array.real2 + offset;
2010 break;
2011#endif
2012
2013#if FFETARGET_okREAL3
2014 case FFEINFO_kindtypeREAL3:
2015 *aptr = array.real3 + offset;
2016 break;
2017#endif
2018
2019 default:
2020 assert ("bad REAL akindtype" == NULL);
2021 break;
2022 }
2023 break;
2024
2025 case FFEINFO_basictypeCOMPLEX:
2026 switch (akt)
2027 {
2028#if FFETARGET_okCOMPLEX1
2029 case FFEINFO_kindtypeREAL1:
2030 *aptr = array.complex1 + offset;
2031 break;
2032#endif
2033
2034#if FFETARGET_okCOMPLEX2
2035 case FFEINFO_kindtypeREAL2:
2036 *aptr = array.complex2 + offset;
2037 break;
2038#endif
2039
2040#if FFETARGET_okCOMPLEX3
2041 case FFEINFO_kindtypeREAL3:
2042 *aptr = array.complex3 + offset;
2043 break;
2044#endif
2045
2046 default:
2047 assert ("bad COMPLEX akindtype" == NULL);
2048 break;
2049 }
2050 break;
2051
2052 case FFEINFO_basictypeCHARACTER:
2053 switch (akt)
2054 {
2055#if FFETARGET_okCHARACTER1
2056 case FFEINFO_kindtypeCHARACTER1:
2057 *aptr = array.character1 + offset;
2058 break;
2059#endif
2060
2061 default:
2062 assert ("bad CHARACTER akindtype" == NULL);
2063 break;
2064 }
2065 break;
2066
2067 default:
2068 assert ("bad abasictype" == NULL);
2069 break;
2070 }
2071
2072 switch (cbt)
2073 {
2074 case FFEINFO_basictypeINTEGER:
2075 switch (ckt)
2076 {
2077#if FFETARGET_okINTEGER1
2078 case FFEINFO_kindtypeINTEGER1:
2079 *cptr = source_array.integer1;
2080 *size = sizeof (*source_array.integer1);
2081 break;
2082#endif
2083
2084#if FFETARGET_okINTEGER2
2085 case FFEINFO_kindtypeINTEGER2:
2086 *cptr = source_array.integer2;
2087 *size = sizeof (*source_array.integer2);
2088 break;
2089#endif
2090
2091#if FFETARGET_okINTEGER3
2092 case FFEINFO_kindtypeINTEGER3:
2093 *cptr = source_array.integer3;
2094 *size = sizeof (*source_array.integer3);
2095 break;
2096#endif
2097
2098#if FFETARGET_okINTEGER4
2099 case FFEINFO_kindtypeINTEGER4:
2100 *cptr = source_array.integer4;
2101 *size = sizeof (*source_array.integer4);
2102 break;
2103#endif
2104
2105 default:
2106 assert ("bad INTEGER ckindtype" == NULL);
2107 break;
2108 }
2109 break;
2110
2111 case FFEINFO_basictypeLOGICAL:
2112 switch (ckt)
2113 {
2114#if FFETARGET_okLOGICAL1
2115 case FFEINFO_kindtypeLOGICAL1:
2116 *cptr = source_array.logical1;
2117 *size = sizeof (*source_array.logical1);
2118 break;
2119#endif
2120
2121#if FFETARGET_okLOGICAL2
2122 case FFEINFO_kindtypeLOGICAL2:
2123 *cptr = source_array.logical2;
2124 *size = sizeof (*source_array.logical2);
2125 break;
2126#endif
2127
2128#if FFETARGET_okLOGICAL3
2129 case FFEINFO_kindtypeLOGICAL3:
2130 *cptr = source_array.logical3;
2131 *size = sizeof (*source_array.logical3);
2132 break;
2133#endif
2134
2135#if FFETARGET_okLOGICAL4
2136 case FFEINFO_kindtypeLOGICAL4:
2137 *cptr = source_array.logical4;
2138 *size = sizeof (*source_array.logical4);
2139 break;
2140#endif
2141
2142 default:
2143 assert ("bad LOGICAL ckindtype" == NULL);
2144 break;
2145 }
2146 break;
2147
2148 case FFEINFO_basictypeREAL:
2149 switch (ckt)
2150 {
2151#if FFETARGET_okREAL1
2152 case FFEINFO_kindtypeREAL1:
2153 *cptr = source_array.real1;
2154 *size = sizeof (*source_array.real1);
2155 break;
2156#endif
2157
2158#if FFETARGET_okREAL2
2159 case FFEINFO_kindtypeREAL2:
2160 *cptr = source_array.real2;
2161 *size = sizeof (*source_array.real2);
2162 break;
2163#endif
2164
2165#if FFETARGET_okREAL3
2166 case FFEINFO_kindtypeREAL3:
2167 *cptr = source_array.real3;
2168 *size = sizeof (*source_array.real3);
2169 break;
2170#endif
2171
2172 default:
2173 assert ("bad REAL ckindtype" == NULL);
2174 break;
2175 }
2176 break;
2177
2178 case FFEINFO_basictypeCOMPLEX:
2179 switch (ckt)
2180 {
2181#if FFETARGET_okCOMPLEX1
2182 case FFEINFO_kindtypeREAL1:
2183 *cptr = source_array.complex1;
2184 *size = sizeof (*source_array.complex1);
2185 break;
2186#endif
2187
2188#if FFETARGET_okCOMPLEX2
2189 case FFEINFO_kindtypeREAL2:
2190 *cptr = source_array.complex2;
2191 *size = sizeof (*source_array.complex2);
2192 break;
2193#endif
2194
2195#if FFETARGET_okCOMPLEX3
2196 case FFEINFO_kindtypeREAL3:
2197 *cptr = source_array.complex3;
2198 *size = sizeof (*source_array.complex3);
2199 break;
2200#endif
2201
2202 default:
2203 assert ("bad COMPLEX ckindtype" == NULL);
2204 break;
2205 }
2206 break;
2207
2208 case FFEINFO_basictypeCHARACTER:
2209 switch (ckt)
2210 {
2211#if FFETARGET_okCHARACTER1
2212 case FFEINFO_kindtypeCHARACTER1:
2213 *cptr = source_array.character1;
2214 *size = sizeof (*source_array.character1);
2215 break;
2216#endif
2217
2218 default:
2219 assert ("bad CHARACTER ckindtype" == NULL);
2220 break;
2221 }
2222 break;
2223
2224 default:
2225 assert ("bad cbasictype" == NULL);
2226 break;
2227 }
2228}
2229
2230/* ffebld_constantarray_prepare -- Prepare for copy between value and array
2231
2232 See prototype.
2233
2234 Like _put, but just returns the pointers to the beginnings of the
2235 array and the constant and returns the size (the amount of info to
2236 copy). The idea is that the caller can use memcpy to accomplish the
2237 same thing as _put (though slower), or the caller can use a different
2238 function that swaps bytes, words, etc for a different target machine.
2239 Also, the type of the array may be different from the type of the
2240 constant; the array type is used to determine the meaning (scale) of
2241 the offset field (to calculate the array pointer), the constant type is
2242 used to determine the constant pointer and the size (amount of info to
2243 copy). */
2244
2245void
2246ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
2247 ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
2248 ffetargetOffset offset, ffebldConstantUnion *constant,
2249 ffeinfoBasictype cbt, ffeinfoKindtype ckt)
2250{
2251 switch (abt)
2252 {
2253 case FFEINFO_basictypeINTEGER:
2254 switch (akt)
2255 {
2256#if FFETARGET_okINTEGER1
2257 case FFEINFO_kindtypeINTEGER1:
2258 *aptr = array.integer1 + offset;
2259 break;
2260#endif
2261
2262#if FFETARGET_okINTEGER2
2263 case FFEINFO_kindtypeINTEGER2:
2264 *aptr = array.integer2 + offset;
2265 break;
2266#endif
2267
2268#if FFETARGET_okINTEGER3
2269 case FFEINFO_kindtypeINTEGER3:
2270 *aptr = array.integer3 + offset;
2271 break;
2272#endif
2273
2274#if FFETARGET_okINTEGER4
2275 case FFEINFO_kindtypeINTEGER4:
2276 *aptr = array.integer4 + offset;
2277 break;
2278#endif
2279
2280 default:
2281 assert ("bad INTEGER akindtype" == NULL);
2282 break;
2283 }
2284 break;
2285
2286 case FFEINFO_basictypeLOGICAL:
2287 switch (akt)
2288 {
2289#if FFETARGET_okLOGICAL1
2290 case FFEINFO_kindtypeLOGICAL1:
2291 *aptr = array.logical1 + offset;
2292 break;
2293#endif
2294
2295#if FFETARGET_okLOGICAL2
2296 case FFEINFO_kindtypeLOGICAL2:
2297 *aptr = array.logical2 + offset;
2298 break;
2299#endif
2300
2301#if FFETARGET_okLOGICAL3
2302 case FFEINFO_kindtypeLOGICAL3:
2303 *aptr = array.logical3 + offset;
2304 break;
2305#endif
2306
2307#if FFETARGET_okLOGICAL4
2308 case FFEINFO_kindtypeLOGICAL4:
2309 *aptr = array.logical4 + offset;
2310 break;
2311#endif
2312
2313 default:
2314 assert ("bad LOGICAL akindtype" == NULL);
2315 break;
2316 }
2317 break;
2318
2319 case FFEINFO_basictypeREAL:
2320 switch (akt)
2321 {
2322#if FFETARGET_okREAL1
2323 case FFEINFO_kindtypeREAL1:
2324 *aptr = array.real1 + offset;
2325 break;
2326#endif
2327
2328#if FFETARGET_okREAL2
2329 case FFEINFO_kindtypeREAL2:
2330 *aptr = array.real2 + offset;
2331 break;
2332#endif
2333
2334#if FFETARGET_okREAL3
2335 case FFEINFO_kindtypeREAL3:
2336 *aptr = array.real3 + offset;
2337 break;
2338#endif
2339
2340 default:
2341 assert ("bad REAL akindtype" == NULL);
2342 break;
2343 }
2344 break;
2345
2346 case FFEINFO_basictypeCOMPLEX:
2347 switch (akt)
2348 {
2349#if FFETARGET_okCOMPLEX1
2350 case FFEINFO_kindtypeREAL1:
2351 *aptr = array.complex1 + offset;
2352 break;
2353#endif
2354
2355#if FFETARGET_okCOMPLEX2
2356 case FFEINFO_kindtypeREAL2:
2357 *aptr = array.complex2 + offset;
2358 break;
2359#endif
2360
2361#if FFETARGET_okCOMPLEX3
2362 case FFEINFO_kindtypeREAL3:
2363 *aptr = array.complex3 + offset;
2364 break;
2365#endif
2366
2367 default:
2368 assert ("bad COMPLEX akindtype" == NULL);
2369 break;
2370 }
2371 break;
2372
2373 case FFEINFO_basictypeCHARACTER:
2374 switch (akt)
2375 {
2376#if FFETARGET_okCHARACTER1
2377 case FFEINFO_kindtypeCHARACTER1:
2378 *aptr = array.character1 + offset;
2379 break;
2380#endif
2381
2382 default:
2383 assert ("bad CHARACTER akindtype" == NULL);
2384 break;
2385 }
2386 break;
2387
2388 default:
2389 assert ("bad abasictype" == NULL);
2390 break;
2391 }
2392
2393 switch (cbt)
2394 {
2395 case FFEINFO_basictypeINTEGER:
2396 switch (ckt)
2397 {
2398#if FFETARGET_okINTEGER1
2399 case FFEINFO_kindtypeINTEGER1:
2400 *cptr = &constant->integer1;
2401 *size = sizeof (constant->integer1);
2402 break;
2403#endif
2404
2405#if FFETARGET_okINTEGER2
2406 case FFEINFO_kindtypeINTEGER2:
2407 *cptr = &constant->integer2;
2408 *size = sizeof (constant->integer2);
2409 break;
2410#endif
2411
2412#if FFETARGET_okINTEGER3
2413 case FFEINFO_kindtypeINTEGER3:
2414 *cptr = &constant->integer3;
2415 *size = sizeof (constant->integer3);
2416 break;
2417#endif
2418
2419#if FFETARGET_okINTEGER4
2420 case FFEINFO_kindtypeINTEGER4:
2421 *cptr = &constant->integer4;
2422 *size = sizeof (constant->integer4);
2423 break;
2424#endif
2425
2426 default:
2427 assert ("bad INTEGER ckindtype" == NULL);
2428 break;
2429 }
2430 break;
2431
2432 case FFEINFO_basictypeLOGICAL:
2433 switch (ckt)
2434 {
2435#if FFETARGET_okLOGICAL1
2436 case FFEINFO_kindtypeLOGICAL1:
2437 *cptr = &constant->logical1;
2438 *size = sizeof (constant->logical1);
2439 break;
2440#endif
2441
2442#if FFETARGET_okLOGICAL2
2443 case FFEINFO_kindtypeLOGICAL2:
2444 *cptr = &constant->logical2;
2445 *size = sizeof (constant->logical2);
2446 break;
2447#endif
2448
2449#if FFETARGET_okLOGICAL3
2450 case FFEINFO_kindtypeLOGICAL3:
2451 *cptr = &constant->logical3;
2452 *size = sizeof (constant->logical3);
2453 break;
2454#endif
2455
2456#if FFETARGET_okLOGICAL4
2457 case FFEINFO_kindtypeLOGICAL4:
2458 *cptr = &constant->logical4;
2459 *size = sizeof (constant->logical4);
2460 break;
2461#endif
2462
2463 default:
2464 assert ("bad LOGICAL ckindtype" == NULL);
2465 break;
2466 }
2467 break;
2468
2469 case FFEINFO_basictypeREAL:
2470 switch (ckt)
2471 {
2472#if FFETARGET_okREAL1
2473 case FFEINFO_kindtypeREAL1:
2474 *cptr = &constant->real1;
2475 *size = sizeof (constant->real1);
2476 break;
2477#endif
2478
2479#if FFETARGET_okREAL2
2480 case FFEINFO_kindtypeREAL2:
2481 *cptr = &constant->real2;
2482 *size = sizeof (constant->real2);
2483 break;
2484#endif
2485
2486#if FFETARGET_okREAL3
2487 case FFEINFO_kindtypeREAL3:
2488 *cptr = &constant->real3;
2489 *size = sizeof (constant->real3);
2490 break;
2491#endif
2492
2493 default:
2494 assert ("bad REAL ckindtype" == NULL);
2495 break;
2496 }
2497 break;
2498
2499 case FFEINFO_basictypeCOMPLEX:
2500 switch (ckt)
2501 {
2502#if FFETARGET_okCOMPLEX1
2503 case FFEINFO_kindtypeREAL1:
2504 *cptr = &constant->complex1;
2505 *size = sizeof (constant->complex1);
2506 break;
2507#endif
2508
2509#if FFETARGET_okCOMPLEX2
2510 case FFEINFO_kindtypeREAL2:
2511 *cptr = &constant->complex2;
2512 *size = sizeof (constant->complex2);
2513 break;
2514#endif
2515
2516#if FFETARGET_okCOMPLEX3
2517 case FFEINFO_kindtypeREAL3:
2518 *cptr = &constant->complex3;
2519 *size = sizeof (constant->complex3);
2520 break;
2521#endif
2522
2523 default:
2524 assert ("bad COMPLEX ckindtype" == NULL);
2525 break;
2526 }
2527 break;
2528
2529 case FFEINFO_basictypeCHARACTER:
2530 switch (ckt)
2531 {
2532#if FFETARGET_okCHARACTER1
2533 case FFEINFO_kindtypeCHARACTER1:
2534 *cptr = ffetarget_text_character1 (constant->character1);
2535 *size = ffetarget_length_character1 (constant->character1);
2536 break;
2537#endif
2538
2539 default:
2540 assert ("bad CHARACTER ckindtype" == NULL);
2541 break;
2542 }
2543 break;
2544
2545 default:
2546 assert ("bad cbasictype" == NULL);
2547 break;
2548 }
2549}
2550
2551/* ffebld_constantarray_put -- Put a value into an array of constants
2552
2553 See prototype. */
2554
2555void
2556ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
2557 ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant)
2558{
2559 switch (bt)
2560 {
2561 case FFEINFO_basictypeINTEGER:
2562 switch (kt)
2563 {
2564#if FFETARGET_okINTEGER1
2565 case FFEINFO_kindtypeINTEGER1:
2566 *(array.integer1 + offset) = constant.integer1;
2567 break;
2568#endif
2569
2570#if FFETARGET_okINTEGER2
2571 case FFEINFO_kindtypeINTEGER2:
2572 *(array.integer2 + offset) = constant.integer2;
2573 break;
2574#endif
2575
2576#if FFETARGET_okINTEGER3
2577 case FFEINFO_kindtypeINTEGER3:
2578 *(array.integer3 + offset) = constant.integer3;
2579 break;
2580#endif
2581
2582#if FFETARGET_okINTEGER4
2583 case FFEINFO_kindtypeINTEGER4:
2584 *(array.integer4 + offset) = constant.integer4;
2585 break;
2586#endif
2587
2588 default:
2589 assert ("bad INTEGER kindtype" == NULL);
2590 break;
2591 }
2592 break;
2593
2594 case FFEINFO_basictypeLOGICAL:
2595 switch (kt)
2596 {
2597#if FFETARGET_okLOGICAL1
2598 case FFEINFO_kindtypeLOGICAL1:
2599 *(array.logical1 + offset) = constant.logical1;
2600 break;
2601#endif
2602
2603#if FFETARGET_okLOGICAL2
2604 case FFEINFO_kindtypeLOGICAL2:
2605 *(array.logical2 + offset) = constant.logical2;
2606 break;
2607#endif
2608
2609#if FFETARGET_okLOGICAL3
2610 case FFEINFO_kindtypeLOGICAL3:
2611 *(array.logical3 + offset) = constant.logical3;
2612 break;
2613#endif
2614
2615#if FFETARGET_okLOGICAL4
2616 case FFEINFO_kindtypeLOGICAL4:
2617 *(array.logical4 + offset) = constant.logical4;
2618 break;
2619#endif
2620
2621 default:
2622 assert ("bad LOGICAL kindtype" == NULL);
2623 break;
2624 }
2625 break;
2626
2627 case FFEINFO_basictypeREAL:
2628 switch (kt)
2629 {
2630#if FFETARGET_okREAL1
2631 case FFEINFO_kindtypeREAL1:
2632 *(array.real1 + offset) = constant.real1;
2633 break;
2634#endif
2635
2636#if FFETARGET_okREAL2
2637 case FFEINFO_kindtypeREAL2:
2638 *(array.real2 + offset) = constant.real2;
2639 break;
2640#endif
2641
2642#if FFETARGET_okREAL3
2643 case FFEINFO_kindtypeREAL3:
2644 *(array.real3 + offset) = constant.real3;
2645 break;
2646#endif
2647
2648 default:
2649 assert ("bad REAL kindtype" == NULL);
2650 break;
2651 }
2652 break;
2653
2654 case FFEINFO_basictypeCOMPLEX:
2655 switch (kt)
2656 {
2657#if FFETARGET_okCOMPLEX1
2658 case FFEINFO_kindtypeREAL1:
2659 *(array.complex1 + offset) = constant.complex1;
2660 break;
2661#endif
2662
2663#if FFETARGET_okCOMPLEX2
2664 case FFEINFO_kindtypeREAL2:
2665 *(array.complex2 + offset) = constant.complex2;
2666 break;
2667#endif
2668
2669#if FFETARGET_okCOMPLEX3
2670 case FFEINFO_kindtypeREAL3:
2671 *(array.complex3 + offset) = constant.complex3;
2672 break;
2673#endif
2674
2675 default:
2676 assert ("bad COMPLEX kindtype" == NULL);
2677 break;
2678 }
2679 break;
2680
2681 case FFEINFO_basictypeCHARACTER:
2682 switch (kt)
2683 {
2684#if FFETARGET_okCHARACTER1
2685 case FFEINFO_kindtypeCHARACTER1:
2686 memcpy (array.character1 + offset,
2687 ffetarget_text_character1 (constant.character1),
2688 ffetarget_length_character1 (constant.character1));
2689 break;
2690#endif
2691
2692 default:
2693 assert ("bad CHARACTER kindtype" == NULL);
2694 break;
2695 }
2696 break;
2697
2698 default:
2699 assert ("bad basictype" == NULL);
2700 break;
2701 }
2702}
2703
2704/* ffebld_init_0 -- Initialize the module
2705
2706 ffebld_init_0(); */
2707
2708void
2709ffebld_init_0 (void)
2710{
2711 assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_));
2712 assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_));
2713}
2714
2715/* ffebld_init_1 -- Initialize the module for a file
2716
2717 ffebld_init_1(); */
2718
2719void
2720ffebld_init_1 (void)
2721{
2722#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
2723 int i;
2724
2725#if FFETARGET_okCHARACTER1
2726 ffebld_constant_character1_ = NULL;
2727#endif
2728#if FFETARGET_okCOMPLEX1
2729 ffebld_constant_complex1_ = NULL;
2730#endif
2731#if FFETARGET_okCOMPLEX2
2732 ffebld_constant_complex2_ = NULL;
2733#endif
2734#if FFETARGET_okCOMPLEX3
2735 ffebld_constant_complex3_ = NULL;
2736#endif
2737#if FFETARGET_okINTEGER1
2738 ffebld_constant_integer1_ = NULL;
2739#endif
2740#if FFETARGET_okINTEGER2
2741 ffebld_constant_integer2_ = NULL;
2742#endif
2743#if FFETARGET_okINTEGER3
2744 ffebld_constant_integer3_ = NULL;
2745#endif
2746#if FFETARGET_okINTEGER4
2747 ffebld_constant_integer4_ = NULL;
2748#endif
2749#if FFETARGET_okLOGICAL1
2750 ffebld_constant_logical1_ = NULL;
2751#endif
2752#if FFETARGET_okLOGICAL2
2753 ffebld_constant_logical2_ = NULL;
2754#endif
2755#if FFETARGET_okLOGICAL3
2756 ffebld_constant_logical3_ = NULL;
2757#endif
2758#if FFETARGET_okLOGICAL4
2759 ffebld_constant_logical4_ = NULL;
2760#endif
2761#if FFETARGET_okREAL1
2762 ffebld_constant_real1_ = NULL;
2763#endif
2764#if FFETARGET_okREAL2
2765 ffebld_constant_real2_ = NULL;
2766#endif
2767#if FFETARGET_okREAL3
2768 ffebld_constant_real3_ = NULL;
2769#endif
2770 ffebld_constant_hollerith_ = NULL;
2771 for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
2772 ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
2773#endif
2774}
2775
2776/* ffebld_init_2 -- Initialize the module
2777
2778 ffebld_init_2(); */
2779
2780void
2781ffebld_init_2 (void)
2782{
2783#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
2784 int i;
2785#endif
2786
2787 ffebld_pool_stack_.next = NULL;
2788 ffebld_pool_stack_.pool = ffe_pool_program_unit ();
2789#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
2790#if FFETARGET_okCHARACTER1
2791 ffebld_constant_character1_ = NULL;
2792#endif
2793#if FFETARGET_okCOMPLEX1
2794 ffebld_constant_complex1_ = NULL;
2795#endif
2796#if FFETARGET_okCOMPLEX2
2797 ffebld_constant_complex2_ = NULL;
2798#endif
2799#if FFETARGET_okCOMPLEX3
2800 ffebld_constant_complex3_ = NULL;
2801#endif
2802#if FFETARGET_okINTEGER1
2803 ffebld_constant_integer1_ = NULL;
2804#endif
2805#if FFETARGET_okINTEGER2
2806 ffebld_constant_integer2_ = NULL;
2807#endif
2808#if FFETARGET_okINTEGER3
2809 ffebld_constant_integer3_ = NULL;
2810#endif
2811#if FFETARGET_okINTEGER4
2812 ffebld_constant_integer4_ = NULL;
2813#endif
2814#if FFETARGET_okLOGICAL1
2815 ffebld_constant_logical1_ = NULL;
2816#endif
2817#if FFETARGET_okLOGICAL2
2818 ffebld_constant_logical2_ = NULL;
2819#endif
2820#if FFETARGET_okLOGICAL3
2821 ffebld_constant_logical3_ = NULL;
2822#endif
2823#if FFETARGET_okLOGICAL4
2824 ffebld_constant_logical4_ = NULL;
2825#endif
2826#if FFETARGET_okREAL1
2827 ffebld_constant_real1_ = NULL;
2828#endif
2829#if FFETARGET_okREAL2
2830 ffebld_constant_real2_ = NULL;
2831#endif
2832#if FFETARGET_okREAL3
2833 ffebld_constant_real3_ = NULL;
2834#endif
2835 ffebld_constant_hollerith_ = NULL;
2836 for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
2837 ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
2838#endif
2839}
2840
2841/* ffebld_list_length -- Return # of opITEMs in list
2842
2843 ffebld list; // Must be NULL or opITEM
2844 ffebldListLength length;
2845 length = ffebld_list_length(list);
2846
2847 Returns 0 if list is NULL, 1 if it's ffebld_trail is NULL, and so on. */
2848
2849ffebldListLength
2850ffebld_list_length (ffebld list)
2851{
2852 ffebldListLength length;
2853
2854 for (length = 0; list != NULL; ++length, list = ffebld_trail (list))
2855 ;
2856
2857 return length;
2858}
2859
2860/* ffebld_new_accter -- Create an ffebld object that is an array
2861
2862 ffebld x;
2863 ffebldConstantArray a;
2864 ffebit b;
2865 x = ffebld_new_accter(a,b); */
2866
2867ffebld
2868ffebld_new_accter (ffebldConstantArray a, ffebit b)
2869{
2870 ffebld x;
2871
2872 x = ffebld_new ();
2873 x->op = FFEBLD_opACCTER;
2874 x->u.accter.array = a;
2875 x->u.accter.bits = b;
2876 x->u.accter.pad = 0;
2877 return x;
2878}
2879
2880/* ffebld_new_arrter -- Create an ffebld object that is an array
2881
2882 ffebld x;
2883 ffebldConstantArray a;
2884 ffetargetOffset size;
2885 x = ffebld_new_arrter(a,size); */
2886
2887ffebld
2888ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
2889{
2890 ffebld x;
2891
2892 x = ffebld_new ();
2893 x->op = FFEBLD_opARRTER;
2894 x->u.arrter.array = a;
2895 x->u.arrter.size = size;
2896 x->u.arrter.pad = 0;
2897 return x;
2898}
2899
2900/* ffebld_new_conter_with_orig -- Create an ffebld object that is a constant
2901
2902 ffebld x;
2903 ffebldConstant c;
2904 x = ffebld_new_conter_with_orig(c,NULL); */
2905
2906ffebld
2907ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
2908{
2909 ffebld x;
2910
2911 x = ffebld_new ();
2912 x->op = FFEBLD_opCONTER;
2913 x->u.conter.expr = c;
2914 x->u.conter.orig = o;
2915 x->u.conter.pad = 0;
2916 return x;
2917}
2918
2919/* ffebld_new_item -- Create an ffebld item object
2920
2921 ffebld x,y,z;
2922 x = ffebld_new_item(y,z); */
2923
2924ffebld
2925ffebld_new_item (ffebld head, ffebld trail)
2926{
2927 ffebld x;
2928
2929 x = ffebld_new ();
2930 x->op = FFEBLD_opITEM;
2931 x->u.item.head = head;
2932 x->u.item.trail = trail;
2933 return x;
2934}
2935
2936/* ffebld_new_labter -- Create an ffebld object that is a label
2937
2938 ffebld x;
2939 ffelab l;
2940 x = ffebld_new_labter(c); */
2941
2942ffebld
2943ffebld_new_labter (ffelab l)
2944{
2945 ffebld x;
2946
2947 x = ffebld_new ();
2948 x->op = FFEBLD_opLABTER;
2949 x->u.labter = l;
2950 return x;
2951}
2952
2953/* ffebld_new_labtok -- Create object that is a label's NUMBER token
2954
2955 ffebld x;
2956 ffelexToken t;
2957 x = ffebld_new_labter(c);
2958
2959 Like the other ffebld_new_ functions, the
2960 supplied argument is stored exactly as is: ffelex_token_use is NOT
2961 called, so the token is "consumed", if one is indeed supplied (it may
2962 be NULL). */
2963
2964ffebld
2965ffebld_new_labtok (ffelexToken t)
2966{
2967 ffebld x;
2968
2969 x = ffebld_new ();
2970 x->op = FFEBLD_opLABTOK;
2971 x->u.labtok = t;
2972 return x;
2973}
2974
2975/* ffebld_new_none -- Create an ffebld object with no arguments
2976
2977 ffebld x;
2978 x = ffebld_new_none(FFEBLD_opWHATEVER); */
2979
2980ffebld
2981ffebld_new_none (ffebldOp o)
2982{
2983 ffebld x;
2984
2985 x = ffebld_new ();
2986 x->op = o;
2987 return x;
2988}
2989
2990/* ffebld_new_one -- Create an ffebld object with one argument
2991
2992 ffebld x,y;
2993 x = ffebld_new_one(FFEBLD_opWHATEVER,y); */
2994
2995ffebld
2996ffebld_new_one (ffebldOp o, ffebld left)
2997{
2998 ffebld x;
2999
3000 x = ffebld_new ();
3001 x->op = o;
3002 x->u.nonter.left = left;
3003 x->u.nonter.hook = FFECOM_nonterNULL;
3004 return x;
3005}
3006
3007/* ffebld_new_symter -- Create an ffebld object that is a symbol
3008
3009 ffebld x;
3010 ffesymbol s;
3011 ffeintrinGen gen; // Generic intrinsic id, if any
3012 ffeintrinSpec spec; // Specific intrinsic id, if any
3013 ffeintrinImp imp; // Implementation intrinsic id, if any
3014 x = ffebld_new_symter (s, gen, spec, imp); */
3015
3016ffebld
3017ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
3018 ffeintrinImp imp)
3019{
3020 ffebld x;
3021
3022 x = ffebld_new ();
3023 x->op = FFEBLD_opSYMTER;
3024 x->u.symter.symbol = s;
3025 x->u.symter.generic = gen;
3026 x->u.symter.specific = spec;
3027 x->u.symter.implementation = imp;
3028 x->u.symter.do_iter = FALSE;
3029 return x;
3030}
3031
3032/* ffebld_new_two -- Create an ffebld object with two arguments
3033
3034 ffebld x,y,z;
3035 x = ffebld_new_two(FFEBLD_opWHATEVER,y,z); */
3036
3037ffebld
3038ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
3039{
3040 ffebld x;
3041
3042 x = ffebld_new ();
3043 x->op = o;
3044 x->u.nonter.left = left;
3045 x->u.nonter.right = right;
3046 x->u.nonter.hook = FFECOM_nonterNULL;
3047 return x;
3048}
3049
3050/* ffebld_pool_pop -- Pop ffebld's pool stack
3051
3052 ffebld_pool_pop(); */
3053
3054void
3055ffebld_pool_pop (void)
3056{
3057 ffebldPoolstack_ ps;
3058
3059 assert (ffebld_pool_stack_.next != NULL);
3060 ps = ffebld_pool_stack_.next;
3061 ffebld_pool_stack_.next = ps->next;
3062 ffebld_pool_stack_.pool = ps->pool;
3063 malloc_kill_ks (malloc_pool_image (), ps, sizeof (*ps));
3064}
3065
3066/* ffebld_pool_push -- Push ffebld's pool stack
3067
3068 ffebld_pool_push(); */
3069
3070void
3071ffebld_pool_push (mallocPool pool)
3072{
3073 ffebldPoolstack_ ps;
3074
3075 ps = malloc_new_ks (malloc_pool_image (), "Pool stack", sizeof (*ps));
3076 ps->next = ffebld_pool_stack_.next;
3077 ps->pool = ffebld_pool_stack_.pool;
3078 ffebld_pool_stack_.next = ps;
3079 ffebld_pool_stack_.pool = pool;
3080}
3081
3082/* ffebld_op_string -- Return short string describing op
3083
3084 ffebldOp o;
3085 ffebld_op_string(o);
3086
3087 Returns a short string (uppercase) containing the name of the op. */
3088
3089const char *
3090ffebld_op_string (ffebldOp o)
3091{
3092 if (o >= ARRAY_SIZE (ffebld_op_string_))
3093 return "?\?\?";
3094 return ffebld_op_string_[o];
3095}
3096
3097/* ffebld_size_max -- Return maximum possible size of CHARACTER-type expr
3098
3099 ffetargetCharacterSize sz;
3100 ffebld b;
3101 sz = ffebld_size_max (b);
3102
3103 Like ffebld_size_known, but if that would return NONE and the expression
3104 is opSUBSTR, opCONVERT, opPAREN, or opCONCATENATE, returns ffebld_size_max
3105 of the subexpression(s). */
3106
3107ffetargetCharacterSize
3108ffebld_size_max (ffebld b)
3109{
3110 ffetargetCharacterSize sz;
3111
3112recurse: /* :::::::::::::::::::: */
3113
3114 sz = ffebld_size_known (b);
3115
3116 if (sz != FFETARGET_charactersizeNONE)
3117 return sz;
3118
3119 switch (ffebld_op (b))
3120 {
3121 case FFEBLD_opSUBSTR:
3122 case FFEBLD_opCONVERT:
3123 case FFEBLD_opPAREN:
3124 b = ffebld_left (b);
3125 goto recurse; /* :::::::::::::::::::: */
3126
3127 case FFEBLD_opCONCATENATE:
3128 sz = ffebld_size_max (ffebld_left (b))
3129 + ffebld_size_max (ffebld_right (b));
3130 return sz;
3131
3132 default:
3133 return sz;
3134 }
3135}
Mirror of https://gcc.gnu.org/git/gcc.git