Open64: osprey/kgccfe/gnu/f/bld.c Source File

00001 /* bld.c -- Implementation File (module.c template V1.0)
00002    Copyright (C) 1995, 1996 Free Software Foundation, Inc.
00003    Contributed by James Craig Burley.
00004 
00005 This file is part of GNU Fortran.
00006 
00007 GNU Fortran is free software; you can redistribute it and/or modify
00008 it under the terms of the GNU General Public License as published by
00009 the Free Software Foundation; either version 2, or (at your option)
00010 any later version.
00011 
00012 GNU Fortran is distributed in the hope that it will be useful,
00013 but WITHOUT ANY WARRANTY; without even the implied warranty of
00014 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00015 GNU General Public License for more details.
00016 
00017 You should have received a copy of the GNU General Public License
00018 along with GNU Fortran; see the file COPYING.  If not, write to
00019 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
00020 02111-1307, USA.
00021 
00022    Related Modules:
00023       None
00024 
00025    Description:
00026       The primary "output" of the FFE includes ffebld objects, which
00027       connect expressions, operators, and operands together, along with
00028       connecting lists of expressions together for argument or dimension
00029       lists.
00030 
00031    Modifications:
00032       30-Aug-92  JCB  1.1
00033    Change names of some things for consistency.
00034 */
00035 
00036 /* Include files. */
00037 
00038 #include "proj.h"
00039 #include "bld.h"
00040 #include "bit.h"
00041 #include "info.h"
00042 #include "lex.h"
00043 #include "malloc.h"
00044 #include "target.h"
00045 #include "where.h"
00046 
00047 /* Externals defined here.  */
00048 
00049 const ffebldArity ffebld_arity_op_[(int) FFEBLD_op]
00050 =
00051 {
00052 #define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
00053 #include "bld-op.def"
00054 #undef FFEBLD_OP
00055 };
00056 struct _ffebld_pool_stack_ ffebld_pool_stack_;
00057 
00058 /* Simple definitions and enumerations. */
00059 
00060 
00061 /* Internal typedefs. */
00062 
00063 
00064 /* Private include files. */
00065 
00066 
00067 /* Internal structure definitions. */
00068 
00069 
00070 /* Static objects accessed by functions in this module.  */
00071 
00072 #if FFEBLD_BLANK_
00073 static struct _ffebld_ ffebld_blank_
00074 =
00075 {
00076   0,
00077   {FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, FFEINFO_kindNONE,
00078    FFEINFO_whereNONE, FFETARGET_charactersizeNONE},
00079   {NULL, NULL}
00080 };
00081 #endif
00082 #if FFETARGET_okCHARACTER1
00083 static ffebldConstant ffebld_constant_character1_;
00084 #endif
00085 #if FFETARGET_okCHARACTER2
00086 static ffebldConstant ffebld_constant_character2_;
00087 #endif
00088 #if FFETARGET_okCHARACTER3
00089 static ffebldConstant ffebld_constant_character3_;
00090 #endif
00091 #if FFETARGET_okCHARACTER4
00092 static ffebldConstant ffebld_constant_character4_;
00093 #endif
00094 #if FFETARGET_okCHARACTER5
00095 static ffebldConstant ffebld_constant_character5_;
00096 #endif
00097 #if FFETARGET_okCHARACTER6
00098 static ffebldConstant ffebld_constant_character6_;
00099 #endif
00100 #if FFETARGET_okCHARACTER7
00101 static ffebldConstant ffebld_constant_character7_;
00102 #endif
00103 #if FFETARGET_okCHARACTER8
00104 static ffebldConstant ffebld_constant_character8_;
00105 #endif
00106 #if FFETARGET_okCOMPLEX1
00107 static ffebldConstant ffebld_constant_complex1_;
00108 #endif
00109 #if FFETARGET_okCOMPLEX2
00110 static ffebldConstant ffebld_constant_complex2_;
00111 #endif
00112 #if FFETARGET_okCOMPLEX3
00113 static ffebldConstant ffebld_constant_complex3_;
00114 #endif
00115 #if FFETARGET_okCOMPLEX4
00116 static ffebldConstant ffebld_constant_complex4_;
00117 #endif
00118 #if FFETARGET_okCOMPLEX5
00119 static ffebldConstant ffebld_constant_complex5_;
00120 #endif
00121 #if FFETARGET_okCOMPLEX6
00122 static ffebldConstant ffebld_constant_complex6_;
00123 #endif
00124 #if FFETARGET_okCOMPLEX7
00125 static ffebldConstant ffebld_constant_complex7_;
00126 #endif
00127 #if FFETARGET_okCOMPLEX8
00128 static ffebldConstant ffebld_constant_complex8_;
00129 #endif
00130 #if FFETARGET_okINTEGER1
00131 static ffebldConstant ffebld_constant_integer1_;
00132 #endif
00133 #if FFETARGET_okINTEGER2
00134 static ffebldConstant ffebld_constant_integer2_;
00135 #endif
00136 #if FFETARGET_okINTEGER3
00137 static ffebldConstant ffebld_constant_integer3_;
00138 #endif
00139 #if FFETARGET_okINTEGER4
00140 static ffebldConstant ffebld_constant_integer4_;
00141 #endif
00142 #if FFETARGET_okINTEGER5
00143 static ffebldConstant ffebld_constant_integer5_;
00144 #endif
00145 #if FFETARGET_okINTEGER6
00146 static ffebldConstant ffebld_constant_integer6_;
00147 #endif
00148 #if FFETARGET_okINTEGER7
00149 static ffebldConstant ffebld_constant_integer7_;
00150 #endif
00151 #if FFETARGET_okINTEGER8
00152 static ffebldConstant ffebld_constant_integer8_;
00153 #endif
00154 #if FFETARGET_okLOGICAL1
00155 static ffebldConstant ffebld_constant_logical1_;
00156 #endif
00157 #if FFETARGET_okLOGICAL2
00158 static ffebldConstant ffebld_constant_logical2_;
00159 #endif
00160 #if FFETARGET_okLOGICAL3
00161 static ffebldConstant ffebld_constant_logical3_;
00162 #endif
00163 #if FFETARGET_okLOGICAL4
00164 static ffebldConstant ffebld_constant_logical4_;
00165 #endif
00166 #if FFETARGET_okLOGICAL5
00167 static ffebldConstant ffebld_constant_logical5_;
00168 #endif
00169 #if FFETARGET_okLOGICAL6
00170 static ffebldConstant ffebld_constant_logical6_;
00171 #endif
00172 #if FFETARGET_okLOGICAL7
00173 static ffebldConstant ffebld_constant_logical7_;
00174 #endif
00175 #if FFETARGET_okLOGICAL8
00176 static ffebldConstant ffebld_constant_logical8_;
00177 #endif
00178 #if FFETARGET_okREAL1
00179 static ffebldConstant ffebld_constant_real1_;
00180 #endif
00181 #if FFETARGET_okREAL2
00182 static ffebldConstant ffebld_constant_real2_;
00183 #endif
00184 #if FFETARGET_okREAL3
00185 static ffebldConstant ffebld_constant_real3_;
00186 #endif
00187 #if FFETARGET_okREAL4
00188 static ffebldConstant ffebld_constant_real4_;
00189 #endif
00190 #if FFETARGET_okREAL5
00191 static ffebldConstant ffebld_constant_real5_;
00192 #endif
00193 #if FFETARGET_okREAL6
00194 static ffebldConstant ffebld_constant_real6_;
00195 #endif
00196 #if FFETARGET_okREAL7
00197 static ffebldConstant ffebld_constant_real7_;
00198 #endif
00199 #if FFETARGET_okREAL8
00200 static ffebldConstant ffebld_constant_real8_;
00201 #endif
00202 static ffebldConstant ffebld_constant_hollerith_;
00203 static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
00204             - FFEBLD_constTYPELESS_FIRST + 1];
00205 
00206 static const char *const ffebld_op_string_[]
00207 =
00208 {
00209 #define FFEBLD_OP(KWD,NAME,ARITY) NAME,
00210 #include "bld-op.def"
00211 #undef FFEBLD_OP
00212 };
00213 
00214 /* Static functions (internal). */
00215 
00216 
00217 /* Internal macros. */
00218 
00219 #define integerdefault_ CATX(integer,FFETARGET_ktINTEGERDEFAULT)
00220 #define logicaldefault_ CATX(logical,FFETARGET_ktLOGICALDEFAULT)
00221 #define realdefault_ CATX(real,FFETARGET_ktREALDEFAULT)
00222 #define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE)
00223 #define realquad_ CATX(real,FFETARGET_ktREALQUAD)
00224 
00225 /* ffebld_constant_cmp -- Compare two constants a la strcmp
00226 
00227    ffebldConstant c1, c2;
00228    if (ffebld_constant_cmp(c1,c2) == 0)
00229        // they're equal, else they're not.
00230 
00231    Returns -1 if c1 < c2, 0 if c1 == c2, +1 if c1 == c2.  */
00232 
00233 int
00234 ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2)
00235 {
00236   if (c1 == c2)
00237     return 0;
00238 
00239   assert (ffebld_constant_type (c1) == ffebld_constant_type (c2));
00240 
00241   switch (ffebld_constant_type (c1))
00242     {
00243 #if FFETARGET_okINTEGER1
00244     case FFEBLD_constINTEGER1:
00245       return ffetarget_cmp_integer1 (ffebld_constant_integer1 (c1),
00246              ffebld_constant_integer1 (c2));
00247 #endif
00248 
00249 #if FFETARGET_okINTEGER2
00250     case FFEBLD_constINTEGER2:
00251       return ffetarget_cmp_integer2 (ffebld_constant_integer2 (c1),
00252              ffebld_constant_integer2 (c2));
00253 #endif
00254 
00255 #if FFETARGET_okINTEGER3
00256     case FFEBLD_constINTEGER3:
00257       return ffetarget_cmp_integer3 (ffebld_constant_integer3 (c1),
00258              ffebld_constant_integer3 (c2));
00259 #endif
00260 
00261 #if FFETARGET_okINTEGER4
00262     case FFEBLD_constINTEGER4:
00263       return ffetarget_cmp_integer4 (ffebld_constant_integer4 (c1),
00264              ffebld_constant_integer4 (c2));
00265 #endif
00266 
00267 #if FFETARGET_okINTEGER5
00268     case FFEBLD_constINTEGER5:
00269       return ffetarget_cmp_integer5 (ffebld_constant_integer5 (c1),
00270              ffebld_constant_integer5 (c2));
00271 #endif
00272 
00273 #if FFETARGET_okINTEGER6
00274     case FFEBLD_constINTEGER6:
00275       return ffetarget_cmp_integer6 (ffebld_constant_integer6 (c1),
00276              ffebld_constant_integer6 (c2));
00277 #endif
00278 
00279 #if FFETARGET_okINTEGER7
00280     case FFEBLD_constINTEGER7:
00281       return ffetarget_cmp_integer7 (ffebld_constant_integer7 (c1),
00282              ffebld_constant_integer7 (c2));
00283 #endif
00284 
00285 #if FFETARGET_okINTEGER8
00286     case FFEBLD_constINTEGER8:
00287       return ffetarget_cmp_integer8 (ffebld_constant_integer8 (c1),
00288              ffebld_constant_integer8 (c2));
00289 #endif
00290 
00291 #if FFETARGET_okLOGICAL1
00292     case FFEBLD_constLOGICAL1:
00293       return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
00294              ffebld_constant_logical1 (c2));
00295 #endif
00296 
00297 #if FFETARGET_okLOGICAL2
00298     case FFEBLD_constLOGICAL2:
00299       return ffetarget_cmp_logical2 (ffebld_constant_logical2 (c1),
00300              ffebld_constant_logical2 (c2));
00301 #endif
00302 
00303 #if FFETARGET_okLOGICAL3
00304     case FFEBLD_constLOGICAL3:
00305       return ffetarget_cmp_logical3 (ffebld_constant_logical3 (c1),
00306              ffebld_constant_logical3 (c2));
00307 #endif
00308 
00309 #if FFETARGET_okLOGICAL4
00310     case FFEBLD_constLOGICAL4:
00311       return ffetarget_cmp_logical4 (ffebld_constant_logical4 (c1),
00312              ffebld_constant_logical4 (c2));
00313 #endif
00314 
00315 #if FFETARGET_okLOGICAL5
00316     case FFEBLD_constLOGICAL5:
00317       return ffetarget_cmp_logical5 (ffebld_constant_logical5 (c1),
00318              ffebld_constant_logical5 (c2));
00319 #endif
00320 
00321 #if FFETARGET_okLOGICAL6
00322     case FFEBLD_constLOGICAL6:
00323       return ffetarget_cmp_logical6 (ffebld_constant_logical6 (c1),
00324              ffebld_constant_logical6 (c2));
00325 #endif
00326 
00327 #if FFETARGET_okLOGICAL7
00328     case FFEBLD_constLOGICAL7:
00329       return ffetarget_cmp_logical7 (ffebld_constant_logical7 (c1),
00330              ffebld_constant_logical7 (c2));
00331 #endif
00332 
00333 #if FFETARGET_okLOGICAL8
00334     case FFEBLD_constLOGICAL8:
00335       return ffetarget_cmp_logical8 (ffebld_constant_logical8 (c1),
00336              ffebld_constant_logical8 (c2));
00337 #endif
00338 
00339 #if FFETARGET_okREAL1
00340     case FFEBLD_constREAL1:
00341       return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
00342           ffebld_constant_real1 (c2));
00343 #endif
00344 
00345 #if FFETARGET_okREAL2
00346     case FFEBLD_constREAL2:
00347       return ffetarget_cmp_real2 (ffebld_constant_real2 (c1),
00348           ffebld_constant_real2 (c2));
00349 #endif
00350 
00351 #if FFETARGET_okREAL3
00352     case FFEBLD_constREAL3:
00353       return ffetarget_cmp_real3 (ffebld_constant_real3 (c1),
00354           ffebld_constant_real3 (c2));
00355 #endif
00356 
00357 #if FFETARGET_okREAL4
00358     case FFEBLD_constREAL4:
00359       return ffetarget_cmp_real4 (ffebld_constant_real4 (c1),
00360           ffebld_constant_real4 (c2));
00361 #endif
00362 
00363 #if FFETARGET_okREAL5
00364     case FFEBLD_constREAL5:
00365       return ffetarget_cmp_real5 (ffebld_constant_real5 (c1),
00366           ffebld_constant_real5 (c2));
00367 #endif
00368 
00369 #if FFETARGET_okREAL6
00370     case FFEBLD_constREAL6:
00371       return ffetarget_cmp_real6 (ffebld_constant_real6 (c1),
00372           ffebld_constant_real6 (c2));
00373 #endif
00374 
00375 #if FFETARGET_okREAL7
00376     case FFEBLD_constREAL7:
00377       return ffetarget_cmp_real7 (ffebld_constant_real7 (c1),
00378           ffebld_constant_real7 (c2));
00379 #endif
00380 
00381 #if FFETARGET_okREAL8
00382     case FFEBLD_constREAL8:
00383       return ffetarget_cmp_real8 (ffebld_constant_real8 (c1),
00384           ffebld_constant_real8 (c2));
00385 #endif
00386 
00387 #if FFETARGET_okCHARACTER1
00388     case FFEBLD_constCHARACTER1:
00389       return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
00390                ffebld_constant_character1 (c2));
00391 #endif
00392 
00393 #if FFETARGET_okCHARACTER2
00394     case FFEBLD_constCHARACTER2:
00395       return ffetarget_cmp_character2 (ffebld_constant_character2 (c1),
00396                ffebld_constant_character2 (c2));
00397 #endif
00398 
00399 #if FFETARGET_okCHARACTER3
00400     case FFEBLD_constCHARACTER3:
00401       return ffetarget_cmp_character3 (ffebld_constant_character3 (c1),
00402                ffebld_constant_character3 (c2));
00403 #endif
00404 
00405 #if FFETARGET_okCHARACTER4
00406     case FFEBLD_constCHARACTER4:
00407       return ffetarget_cmp_character4 (ffebld_constant_character4 (c1),
00408                ffebld_constant_character4 (c2));
00409 #endif
00410 
00411 #if FFETARGET_okCHARACTER5
00412     case FFEBLD_constCHARACTER5:
00413       return ffetarget_cmp_character5 (ffebld_constant_character5 (c1),
00414                ffebld_constant_character5 (c2));
00415 #endif
00416 
00417 #if FFETARGET_okCHARACTER6
00418     case FFEBLD_constCHARACTER6:
00419       return ffetarget_cmp_character6 (ffebld_constant_character6 (c1),
00420                ffebld_constant_character6 (c2));
00421 #endif
00422 
00423 #if FFETARGET_okCHARACTER7
00424     case FFEBLD_constCHARACTER7:
00425       return ffetarget_cmp_character7 (ffebld_constant_character7 (c1),
00426                ffebld_constant_character7 (c2));
00427 #endif
00428 
00429 #if FFETARGET_okCHARACTER8
00430     case FFEBLD_constCHARACTER8:
00431       return ffetarget_cmp_character8 (ffebld_constant_character8 (c1),
00432                ffebld_constant_character8 (c2));
00433 #endif
00434 
00435     default:
00436       assert ("bad constant type" == NULL);
00437       return 0;
00438     }
00439 }
00440 
00441 /* ffebld_constant_is_magical -- Determine if integer is "magical"
00442 
00443    ffebldConstant c;
00444    if (ffebld_constant_is_magical(c))
00445        // it is 2**(n-1), where n is # bits in ffetargetIntegerDefault type
00446        // (this test is important for 2's-complement machines only).  */
00447 
00448 bool
00449 ffebld_constant_is_magical (ffebldConstant c)
00450 {
00451   switch (ffebld_constant_type (c))
00452     {
00453     case FFEBLD_constINTEGERDEFAULT:
00454       return ffetarget_integerdefault_is_magical (ffebld_constant_integer1 (c));
00455 
00456     default:
00457       return FALSE;
00458     }
00459 }
00460 
00461 /* Determine if constant is zero.  Used to ensure step count
00462    for DO loops isn't zero, also to determine if values will
00463    be binary zeros, so not entirely portable at this point.  */
00464 
00465 bool
00466 ffebld_constant_is_zero (ffebldConstant c)
00467 {
00468   switch (ffebld_constant_type (c))
00469     {
00470 #if FFETARGET_okINTEGER1
00471     case FFEBLD_constINTEGER1:
00472       return ffebld_constant_integer1 (c) == 0;
00473 #endif
00474 
00475 #if FFETARGET_okINTEGER2
00476     case FFEBLD_constINTEGER2:
00477       return ffebld_constant_integer2 (c) == 0;
00478 #endif
00479 
00480 #if FFETARGET_okINTEGER3
00481     case FFEBLD_constINTEGER3:
00482       return ffebld_constant_integer3 (c) == 0;
00483 #endif
00484 
00485 #if FFETARGET_okINTEGER4
00486     case FFEBLD_constINTEGER4:
00487       return ffebld_constant_integer4 (c) == 0;
00488 #endif
00489 
00490 #if FFETARGET_okINTEGER5
00491     case FFEBLD_constINTEGER5:
00492       return ffebld_constant_integer5 (c) == 0;
00493 #endif
00494 
00495 #if FFETARGET_okINTEGER6
00496     case FFEBLD_constINTEGER6:
00497       return ffebld_constant_integer6 (c) == 0;
00498 #endif
00499 
00500 #if FFETARGET_okINTEGER7
00501     case FFEBLD_constINTEGER7:
00502       return ffebld_constant_integer7 (c) == 0;
00503 #endif
00504 
00505 #if FFETARGET_okINTEGER8
00506     case FFEBLD_constINTEGER8:
00507       return ffebld_constant_integer8 (c) == 0;
00508 #endif
00509 
00510 #if FFETARGET_okLOGICAL1
00511     case FFEBLD_constLOGICAL1:
00512       return ffebld_constant_logical1 (c) == 0;
00513 #endif
00514 
00515 #if FFETARGET_okLOGICAL2
00516     case FFEBLD_constLOGICAL2:
00517       return ffebld_constant_logical2 (c) == 0;
00518 #endif
00519 
00520 #if FFETARGET_okLOGICAL3
00521     case FFEBLD_constLOGICAL3:
00522       return ffebld_constant_logical3 (c) == 0;
00523 #endif
00524 
00525 #if FFETARGET_okLOGICAL4
00526     case FFEBLD_constLOGICAL4:
00527       return ffebld_constant_logical4 (c) == 0;
00528 #endif
00529 
00530 #if FFETARGET_okLOGICAL5
00531     case FFEBLD_constLOGICAL5:
00532       return ffebld_constant_logical5 (c) == 0;
00533 #endif
00534 
00535 #if FFETARGET_okLOGICAL6
00536     case FFEBLD_constLOGICAL6:
00537       return ffebld_constant_logical6 (c) == 0;
00538 #endif
00539 
00540 #if FFETARGET_okLOGICAL7
00541     case FFEBLD_constLOGICAL7:
00542       return ffebld_constant_logical7 (c) == 0;
00543 #endif
00544 
00545 #if FFETARGET_okLOGICAL8
00546     case FFEBLD_constLOGICAL8:
00547       return ffebld_constant_logical8 (c) == 0;
00548 #endif
00549 
00550 #if FFETARGET_okREAL1
00551     case FFEBLD_constREAL1:
00552       return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
00553 #endif
00554 
00555 #if FFETARGET_okREAL2
00556     case FFEBLD_constREAL2:
00557       return ffetarget_iszero_real2 (ffebld_constant_real2 (c));
00558 #endif
00559 
00560 #if FFETARGET_okREAL3
00561     case FFEBLD_constREAL3:
00562       return ffetarget_iszero_real3 (ffebld_constant_real3 (c));
00563 #endif
00564 
00565 #if FFETARGET_okREAL4
00566     case FFEBLD_constREAL4:
00567       return ffetarget_iszero_real4 (ffebld_constant_real4 (c));
00568 #endif
00569 
00570 #if FFETARGET_okREAL5
00571     case FFEBLD_constREAL5:
00572       return ffetarget_iszero_real5 (ffebld_constant_real5 (c));
00573 #endif
00574 
00575 #if FFETARGET_okREAL6
00576     case FFEBLD_constREAL6:
00577       return ffetarget_iszero_real6 (ffebld_constant_real6 (c));
00578 #endif
00579 
00580 #if FFETARGET_okREAL7
00581     case FFEBLD_constREAL7:
00582       return ffetarget_iszero_real7 (ffebld_constant_real7 (c));
00583 #endif
00584 
00585 #if FFETARGET_okREAL8
00586     case FFEBLD_constREAL8:
00587       return ffetarget_iszero_real8 (ffebld_constant_real8 (c));
00588 #endif
00589 
00590 #if FFETARGET_okCOMPLEX1
00591     case FFEBLD_constCOMPLEX1:
00592       return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real)
00593      && ffetarget_iszero_real1 (ffebld_constant_complex1 (c).imaginary);
00594 #endif
00595 
00596 #if FFETARGET_okCOMPLEX2
00597     case FFEBLD_constCOMPLEX2:
00598       return ffetarget_iszero_real2 (ffebld_constant_complex2 (c).real)
00599      && ffetarget_iszero_real2 (ffebld_constant_complex2 (c).imaginary);
00600 #endif
00601 
00602 #if FFETARGET_okCOMPLEX3
00603     case FFEBLD_constCOMPLEX3:
00604       return ffetarget_iszero_real3 (ffebld_constant_complex3 (c).real)
00605      && ffetarget_iszero_real3 (ffebld_constant_complex3 (c).imaginary);
00606 #endif
00607 
00608 #if FFETARGET_okCOMPLEX4
00609     case FFEBLD_constCOMPLEX4:
00610       return ffetarget_iszero_real4 (ffebld_constant_complex4 (c).real)
00611      && ffetarget_iszero_real4 (ffebld_constant_complex4 (c).imaginary);
00612 #endif
00613 
00614 #if FFETARGET_okCOMPLEX5
00615     case FFEBLD_constCOMPLEX5:
00616       return ffetarget_iszero_real5 (ffebld_constant_complex5 (c).real)
00617      && ffetarget_iszero_real5 (ffebld_constant_complex5 (c).imaginary);
00618 #endif
00619 
00620 #if FFETARGET_okCOMPLEX6
00621     case FFEBLD_constCOMPLEX6:
00622       return ffetarget_iszero_real6 (ffebld_constant_complex6 (c).real)
00623      && ffetarget_iszero_real6 (ffebld_constant_complex6 (c).imaginary);
00624 #endif
00625 
00626 #if FFETARGET_okCOMPLEX7
00627     case FFEBLD_constCOMPLEX7:
00628       return ffetarget_iszero_real7 (ffebld_constant_complex7 (c).real)
00629      && ffetarget_iszero_real7 (ffebld_constant_complex7 (c).imaginary);
00630 #endif
00631 
00632 #if FFETARGET_okCOMPLEX8
00633     case FFEBLD_constCOMPLEX8:
00634       return ffetarget_iszero_real8 (ffebld_constant_complex8 (c).real)
00635      && ffetarget_iszero_real8 (ffebld_constant_complex8 (c).imaginary);
00636 #endif
00637 
00638 #if FFETARGET_okCHARACTER1
00639     case FFEBLD_constCHARACTER1:
00640       return ffetarget_iszero_character1 (ffebld_constant_character1 (c));
00641 #endif
00642 
00643 #if FFETARGET_okCHARACTER2 || FFETARGET_okCHARACTER3  /* ... */
00644 #error "no support for these!!"
00645 #endif
00646 
00647     case FFEBLD_constHOLLERITH:
00648       return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c));
00649 
00650     case FFEBLD_constBINARY_MIL:
00651     case FFEBLD_constBINARY_VXT:
00652     case FFEBLD_constOCTAL_MIL:
00653     case FFEBLD_constOCTAL_VXT:
00654     case FFEBLD_constHEX_X_MIL:
00655     case FFEBLD_constHEX_X_VXT:
00656     case FFEBLD_constHEX_Z_MIL:
00657     case FFEBLD_constHEX_Z_VXT:
00658       return ffetarget_iszero_typeless (ffebld_constant_typeless (c));
00659 
00660     default:
00661       return FALSE;
00662     }
00663 }
00664 
00665 /* ffebld_constant_new_character1 -- Return character1 constant object from token
00666 
00667    See prototype.  */
00668 
00669 #if FFETARGET_okCHARACTER1
00670 ffebldConstant
00671 ffebld_constant_new_character1 (ffelexToken t)
00672 {
00673   ffetargetCharacter1 val;
00674 
00675   ffetarget_character1 (&val, t, ffebld_constant_pool());
00676   return ffebld_constant_new_character1_val (val);
00677 }
00678 
00679 #endif
00680 /* ffebld_constant_new_character1_val -- Return an character1 constant object
00681 
00682    See prototype.  */
00683 
00684 #if FFETARGET_okCHARACTER1
00685 ffebldConstant
00686 ffebld_constant_new_character1_val (ffetargetCharacter1 val)
00687 {
00688   ffebldConstant c;
00689   ffebldConstant nc;
00690   int cmp;
00691 
00692   ffetarget_verify_character1 (ffebld_constant_pool(), val);
00693 
00694   for (c = (ffebldConstant) &ffebld_constant_character1_;
00695        c->next != NULL;
00696        c = c->next)
00697     {
00698       malloc_verify_kp (ffebld_constant_pool(),
00699       c->next,
00700       sizeof (*(c->next)));
00701       ffetarget_verify_character1 (ffebld_constant_pool(),
00702            ffebld_constant_character1 (c->next));
00703       cmp = ffetarget_cmp_character1 (val,
00704               ffebld_constant_character1 (c->next));
00705       if (cmp == 0)
00706   return c->next;
00707       if (cmp > 0)
00708   break;
00709     }
00710 
00711   nc = malloc_new_kp (ffebld_constant_pool(),
00712           "FFEBLD_constCHARACTER1",
00713           sizeof (*nc));
00714   nc->next = c->next;
00715   nc->consttype = FFEBLD_constCHARACTER1;
00716   nc->u.character1 = val;
00717 #ifdef FFECOM_constantHOOK
00718   nc->hook = FFECOM_constantNULL;
00719 #endif
00720   c->next = nc;
00721 
00722   return nc;
00723 }
00724 
00725 #endif
00726 /* ffebld_constant_new_complex1 -- Return complex1 constant object from token
00727 
00728    See prototype.  */
00729 
00730 #if FFETARGET_okCOMPLEX1
00731 ffebldConstant
00732 ffebld_constant_new_complex1 (ffebldConstant real,
00733             ffebldConstant imaginary)
00734 {
00735   ffetargetComplex1 val;
00736 
00737   val.real = ffebld_constant_real1 (real);
00738   val.imaginary = ffebld_constant_real1 (imaginary);
00739   return ffebld_constant_new_complex1_val (val);
00740 }
00741 
00742 #endif
00743 /* ffebld_constant_new_complex1_val -- Return a complex1 constant object
00744 
00745    See prototype.  */
00746 
00747 #if FFETARGET_okCOMPLEX1
00748 ffebldConstant
00749 ffebld_constant_new_complex1_val (ffetargetComplex1 val)
00750 {
00751   ffebldConstant c;
00752   ffebldConstant nc;
00753   int cmp;
00754 
00755   for (c = (ffebldConstant) &ffebld_constant_complex1_;
00756        c->next != NULL;
00757        c = c->next)
00758     {
00759       cmp = ffetarget_cmp_real1 (val.real, ffebld_constant_complex1 (c->next).real);
00760       if (cmp == 0)
00761   cmp = ffetarget_cmp_real1 (val.imaginary,
00762             ffebld_constant_complex1 (c->next).imaginary);
00763       if (cmp == 0)
00764   return c->next;
00765       if (cmp > 0)
00766   break;
00767     }
00768 
00769   nc = malloc_new_kp (ffebld_constant_pool(),
00770           "FFEBLD_constCOMPLEX1",
00771           sizeof (*nc));
00772   nc->next = c->next;
00773   nc->consttype = FFEBLD_constCOMPLEX1;
00774   nc->u.complex1 = val;
00775 #ifdef FFECOM_constantHOOK
00776   nc->hook = FFECOM_constantNULL;
00777 #endif
00778   c->next = nc;
00779 
00780   return nc;
00781 }
00782 
00783 #endif
00784 /* ffebld_constant_new_complex2 -- Return complex2 constant object from token
00785 
00786    See prototype.  */
00787 
00788 #if FFETARGET_okCOMPLEX2
00789 ffebldConstant
00790 ffebld_constant_new_complex2 (ffebldConstant real,
00791             ffebldConstant imaginary)
00792 {
00793   ffetargetComplex2 val;
00794 
00795   val.real = ffebld_constant_real2 (real);
00796   val.imaginary = ffebld_constant_real2 (imaginary);
00797   return ffebld_constant_new_complex2_val (val);
00798 }
00799 
00800 #endif
00801 /* ffebld_constant_new_complex2_val -- Return a complex2 constant object
00802 
00803    See prototype.  */
00804 
00805 #if FFETARGET_okCOMPLEX2
00806 ffebldConstant
00807 ffebld_constant_new_complex2_val (ffetargetComplex2 val)
00808 {
00809   ffebldConstant c;
00810   ffebldConstant nc;
00811   int cmp;
00812 
00813   for (c = (ffebldConstant) &ffebld_constant_complex2_;
00814        c->next != NULL;
00815        c = c->next)
00816     {
00817       cmp = ffetarget_cmp_real2 (val.real, ffebld_constant_complex2 (c->next).real);
00818       if (cmp == 0)
00819   cmp = ffetarget_cmp_real2 (val.imaginary,
00820             ffebld_constant_complex2 (c->next).imaginary);
00821       if (cmp == 0)
00822   return c->next;
00823       if (cmp > 0)
00824   break;
00825     }
00826 
00827   nc = malloc_new_kp (ffebld_constant_pool(),
00828           "FFEBLD_constCOMPLEX2",
00829           sizeof (*nc));
00830   nc->next = c->next;
00831   nc->consttype = FFEBLD_constCOMPLEX2;
00832   nc->u.complex2 = val;
00833 #ifdef FFECOM_constantHOOK
00834   nc->hook = FFECOM_constantNULL;
00835 #endif
00836   c->next = nc;
00837 
00838   return nc;
00839 }
00840 
00841 #endif
00842 /* ffebld_constant_new_hollerith -- Return hollerith constant object from token
00843 
00844    See prototype.  */
00845 
00846 ffebldConstant
00847 ffebld_constant_new_hollerith (ffelexToken t)
00848 {
00849   ffetargetHollerith val;
00850 
00851   ffetarget_hollerith (&val, t, ffebld_constant_pool());
00852   return ffebld_constant_new_hollerith_val (val);
00853 }
00854 
00855 /* ffebld_constant_new_hollerith_val -- Return an hollerith constant object
00856 
00857    See prototype.  */
00858 
00859 ffebldConstant
00860 ffebld_constant_new_hollerith_val (ffetargetHollerith val)
00861 {
00862   ffebldConstant c;
00863   ffebldConstant nc;
00864   int cmp;
00865 
00866   for (c = (ffebldConstant) &ffebld_constant_hollerith_;
00867        c->next != NULL;
00868        c = c->next)
00869     {
00870       cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (c->next));
00871       if (cmp == 0)
00872   return c->next;
00873       if (cmp > 0)
00874   break;
00875     }
00876 
00877   nc = malloc_new_kp (ffebld_constant_pool(),
00878           "FFEBLD_constHOLLERITH",
00879           sizeof (*nc));
00880   nc->next = c->next;
00881   nc->consttype = FFEBLD_constHOLLERITH;
00882   nc->u.hollerith = val;
00883 #ifdef FFECOM_constantHOOK
00884   nc->hook = FFECOM_constantNULL;
00885 #endif
00886   c->next = nc;
00887 
00888   return nc;
00889 }
00890 
00891 /* ffebld_constant_new_integer1 -- Return integer1 constant object from token
00892 
00893    See prototype.
00894 
00895    Parses the token as a decimal integer constant, thus it must be an
00896    FFELEX_typeNUMBER.  */
00897 
00898 #if FFETARGET_okINTEGER1
00899 ffebldConstant
00900 ffebld_constant_new_integer1 (ffelexToken t)
00901 {
00902   ffetargetInteger1 val;
00903 
00904   assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
00905 
00906   ffetarget_integer1 (&val, t);
00907   return ffebld_constant_new_integer1_val (val);
00908 }
00909 
00910 #endif
00911 /* ffebld_constant_new_integer1_val -- Return an integer1 constant object
00912 
00913    See prototype.  */
00914 
00915 #if FFETARGET_okINTEGER1
00916 ffebldConstant
00917 ffebld_constant_new_integer1_val (ffetargetInteger1 val)
00918 {
00919   ffebldConstant c;
00920   ffebldConstant nc;
00921   int cmp;
00922 
00923   for (c = (ffebldConstant) &ffebld_constant_integer1_;
00924        c->next != NULL;
00925        c = c->next)
00926     {
00927       cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (c->next));
00928       if (cmp == 0)
00929   return c->next;
00930       if (cmp > 0)
00931   break;
00932     }
00933 
00934   nc = malloc_new_kp (ffebld_constant_pool(),
00935           "FFEBLD_constINTEGER1",
00936           sizeof (*nc));
00937   nc->next = c->next;
00938   nc->consttype = FFEBLD_constINTEGER1;
00939   nc->u.integer1 = val;
00940 #ifdef FFECOM_constantHOOK
00941   nc->hook = FFECOM_constantNULL;
00942 #endif
00943   c->next = nc;
00944 
00945   return nc;
00946 }
00947 
00948 #endif
00949 /* ffebld_constant_new_integer2_val -- Return an integer2 constant object
00950 
00951    See prototype.  */
00952 
00953 #if FFETARGET_okINTEGER2
00954 ffebldConstant
00955 ffebld_constant_new_integer2_val (ffetargetInteger2 val)
00956 {
00957   ffebldConstant c;
00958   ffebldConstant nc;
00959   int cmp;
00960 
00961   for (c = (ffebldConstant) &ffebld_constant_integer2_;
00962        c->next != NULL;
00963        c = c->next)
00964     {
00965       cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (c->next));
00966       if (cmp == 0)
00967   return c->next;
00968       if (cmp > 0)
00969   break;
00970     }
00971 
00972   nc = malloc_new_kp (ffebld_constant_pool(),
00973           "FFEBLD_constINTEGER2",
00974           sizeof (*nc));
00975   nc->next = c->next;
00976   nc->consttype = FFEBLD_constINTEGER2;
00977   nc->u.integer2 = val;
00978 #ifdef FFECOM_constantHOOK
00979   nc->hook = FFECOM_constantNULL;
00980 #endif
00981   c->next = nc;
00982 
00983   return nc;
00984 }
00985 
00986 #endif
00987 /* ffebld_constant_new_integer3_val -- Return an integer3 constant object
00988 
00989    See prototype.  */
00990 
00991 #if FFETARGET_okINTEGER3
00992 ffebldConstant
00993 ffebld_constant_new_integer3_val (ffetargetInteger3 val)
00994 {
00995   ffebldConstant c;
00996   ffebldConstant nc;
00997   int cmp;
00998 
00999   for (c = (ffebldConstant) &ffebld_constant_integer3_;
01000        c->next != NULL;
01001        c = c->next)
01002     {
01003       cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (c->next));
01004       if (cmp == 0)
01005   return c->next;
01006       if (cmp > 0)
01007   break;
01008     }
01009 
01010   nc = malloc_new_kp (ffebld_constant_pool(),
01011           "FFEBLD_constINTEGER3",
01012           sizeof (*nc));
01013   nc->next = c->next;
01014   nc->consttype = FFEBLD_constINTEGER3;
01015   nc->u.integer3 = val;
01016 #ifdef FFECOM_constantHOOK
01017   nc->hook = FFECOM_constantNULL;
01018 #endif
01019   c->next = nc;
01020 
01021   return nc;
01022 }
01023 
01024 #endif
01025 /* ffebld_constant_new_integer4_val -- Return an integer4 constant object
01026 
01027    See prototype.  */
01028 
01029 #if FFETARGET_okINTEGER4
01030 ffebldConstant
01031 ffebld_constant_new_integer4_val (ffetargetInteger4 val)
01032 {
01033   ffebldConstant c;
01034   ffebldConstant nc;
01035   int cmp;
01036 
01037   for (c = (ffebldConstant) &ffebld_constant_integer4_;
01038        c->next != NULL;
01039        c = c->next)
01040     {
01041       cmp = ffetarget_cmp_integer4 (val, ffebld_constant_integer4 (c->next));
01042       if (cmp == 0)
01043   return c->next;
01044       if (cmp > 0)
01045   break;
01046     }
01047 
01048   nc = malloc_new_kp (ffebld_constant_pool(),
01049           "FFEBLD_constINTEGER4",
01050           sizeof (*nc));
01051   nc->next = c->next;
01052   nc->consttype = FFEBLD_constINTEGER4;
01053   nc->u.integer4 = val;
01054 #ifdef FFECOM_constantHOOK
01055   nc->hook = FFECOM_constantNULL;
01056 #endif
01057   c->next = nc;
01058 
01059   return nc;
01060 }
01061 
01062 #endif
01063 /* ffebld_constant_new_integerbinary -- Return binary constant object from token
01064 
01065    See prototype.
01066 
01067    Parses the token as a binary integer constant, thus it must be an
01068    FFELEX_typeNUMBER.  */
01069 
01070 ffebldConstant
01071 ffebld_constant_new_integerbinary (ffelexToken t)
01072 {
01073   ffetargetIntegerDefault val;
01074 
01075   assert ((ffelex_token_type (t) == FFELEX_typeNAME)
01076     || (ffelex_token_type (t) == FFELEX_typeNUMBER));
01077 
01078   ffetarget_integerbinary (&val, t);
01079   return ffebld_constant_new_integerdefault_val (val);
01080 }
01081 
01082 /* ffebld_constant_new_integerhex -- Return hex constant object from token
01083 
01084    See prototype.
01085 
01086    Parses the token as a hex integer constant, thus it must be an
01087    FFELEX_typeNUMBER.  */
01088 
01089 ffebldConstant
01090 ffebld_constant_new_integerhex (ffelexToken t)
01091 {
01092   ffetargetIntegerDefault val;
01093 
01094   assert ((ffelex_token_type (t) == FFELEX_typeNAME)
01095     || (ffelex_token_type (t) == FFELEX_typeNUMBER));
01096 
01097   ffetarget_integerhex (&val, t);
01098   return ffebld_constant_new_integerdefault_val (val);
01099 }
01100 
01101 /* ffebld_constant_new_integeroctal -- Return octal constant object from token
01102 
01103    See prototype.
01104 
01105    Parses the token as a octal integer constant, thus it must be an
01106    FFELEX_typeNUMBER.  */
01107 
01108 ffebldConstant
01109 ffebld_constant_new_integeroctal (ffelexToken t)
01110 {
01111   ffetargetIntegerDefault val;
01112 
01113   assert ((ffelex_token_type (t) == FFELEX_typeNAME)
01114     || (ffelex_token_type (t) == FFELEX_typeNUMBER));
01115 
01116   ffetarget_integeroctal (&val, t);
01117   return ffebld_constant_new_integerdefault_val (val);
01118 }
01119 
01120 /* ffebld_constant_new_logical1 -- Return logical1 constant object from token
01121 
01122    See prototype.
01123 
01124    Parses the token as a decimal logical constant, thus it must be an
01125    FFELEX_typeNUMBER.  */
01126 
01127 #if FFETARGET_okLOGICAL1
01128 ffebldConstant
01129 ffebld_constant_new_logical1 (bool truth)
01130 {
01131   ffetargetLogical1 val;
01132 
01133   ffetarget_logical1 (&val, truth);
01134   return ffebld_constant_new_logical1_val (val);
01135 }
01136 
01137 #endif
01138 /* ffebld_constant_new_logical1_val -- Return a logical1 constant object
01139 
01140    See prototype.  */
01141 
01142 #if FFETARGET_okLOGICAL1
01143 ffebldConstant
01144 ffebld_constant_new_logical1_val (ffetargetLogical1 val)
01145 {
01146   ffebldConstant c;
01147   ffebldConstant nc;
01148   int cmp;
01149 
01150   for (c = (ffebldConstant) &ffebld_constant_logical1_;
01151        c->next != NULL;
01152        c = c->next)
01153     {
01154       cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (c->next));
01155       if (cmp == 0)
01156   return c->next;
01157       if (cmp > 0)
01158   break;
01159     }
01160 
01161   nc = malloc_new_kp (ffebld_constant_pool(),
01162           "FFEBLD_constLOGICAL1",
01163           sizeof (*nc));
01164   nc->next = c->next;
01165   nc->consttype = FFEBLD_constLOGICAL1;
01166   nc->u.logical1 = val;
01167 #ifdef FFECOM_constantHOOK
01168   nc->hook = FFECOM_constantNULL;
01169 #endif
01170   c->next = nc;
01171 
01172   return nc;
01173 }
01174 
01175 #endif
01176 /* ffebld_constant_new_logical2_val -- Return a logical2 constant object
01177 
01178    See prototype.  */
01179 
01180 #if FFETARGET_okLOGICAL2
01181 ffebldConstant
01182 ffebld_constant_new_logical2_val (ffetargetLogical2 val)
01183 {
01184   ffebldConstant c;
01185   ffebldConstant nc;
01186   int cmp;
01187 
01188   for (c = (ffebldConstant) &ffebld_constant_logical2_;
01189        c->next != NULL;
01190        c = c->next)
01191     {
01192       cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (c->next));
01193       if (cmp == 0)
01194   return c->next;
01195       if (cmp > 0)
01196   break;
01197     }
01198 
01199   nc = malloc_new_kp (ffebld_constant_pool(),
01200           "FFEBLD_constLOGICAL2",
01201           sizeof (*nc));
01202   nc->next = c->next;
01203   nc->consttype = FFEBLD_constLOGICAL2;
01204   nc->u.logical2 = val;
01205 #ifdef FFECOM_constantHOOK
01206   nc->hook = FFECOM_constantNULL;
01207 #endif
01208   c->next = nc;
01209 
01210   return nc;
01211 }
01212 
01213 #endif
01214 /* ffebld_constant_new_logical3_val -- Return a logical3 constant object
01215 
01216    See prototype.  */
01217 
01218 #if FFETARGET_okLOGICAL3
01219 ffebldConstant
01220 ffebld_constant_new_logical3_val (ffetargetLogical3 val)
01221 {
01222   ffebldConstant c;
01223   ffebldConstant nc;
01224   int cmp;
01225 
01226   for (c = (ffebldConstant) &ffebld_constant_logical3_;
01227        c->next != NULL;
01228        c = c->next)
01229     {
01230       cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (c->next));
01231       if (cmp == 0)
01232   return c->next;
01233       if (cmp > 0)
01234   break;
01235     }
01236 
01237   nc = malloc_new_kp (ffebld_constant_pool(),
01238           "FFEBLD_constLOGICAL3",
01239           sizeof (*nc));
01240   nc->next = c->next;
01241   nc->consttype = FFEBLD_constLOGICAL3;
01242   nc->u.logical3 = val;
01243 #ifdef FFECOM_constantHOOK
01244   nc->hook = FFECOM_constantNULL;
01245 #endif
01246   c->next = nc;
01247 
01248   return nc;
01249 }
01250 
01251 #endif
01252 /* ffebld_constant_new_logical4_val -- Return a logical4 constant object
01253 
01254    See prototype.  */
01255 
01256 #if FFETARGET_okLOGICAL4
01257 ffebldConstant
01258 ffebld_constant_new_logical4_val (ffetargetLogical4 val)
01259 {
01260   ffebldConstant c;
01261   ffebldConstant nc;
01262   int cmp;
01263 
01264   for (c = (ffebldConstant) &ffebld_constant_logical4_;
01265        c->next != NULL;
01266        c = c->next)
01267     {
01268       cmp = ffetarget_cmp_logical4 (val, ffebld_constant_logical4 (c->next));
01269       if (cmp == 0)
01270   return c->next;
01271       if (cmp > 0)
01272   break;
01273     }
01274 
01275   nc = malloc_new_kp (ffebld_constant_pool(),
01276           "FFEBLD_constLOGICAL4",
01277           sizeof (*nc));
01278   nc->next = c->next;
01279   nc->consttype = FFEBLD_constLOGICAL4;
01280   nc->u.logical4 = val;
01281 #ifdef FFECOM_constantHOOK
01282   nc->hook = FFECOM_constantNULL;
01283 #endif
01284   c->next = nc;
01285 
01286   return nc;
01287 }
01288 
01289 #endif
01290 /* ffebld_constant_new_real1 -- Return real1 constant object from token
01291 
01292    See prototype.  */
01293 
01294 #if FFETARGET_okREAL1
01295 ffebldConstant
01296 ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal,
01297       ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
01298          ffelexToken exponent_digits)
01299 {
01300   ffetargetReal1 val;
01301 
01302   ffetarget_real1 (&val,
01303       integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
01304   return ffebld_constant_new_real1_val (val);
01305 }
01306 
01307 #endif
01308 /* ffebld_constant_new_real1_val -- Return an real1 constant object
01309 
01310    See prototype.  */
01311 
01312 #if FFETARGET_okREAL1
01313 ffebldConstant
01314 ffebld_constant_new_real1_val (ffetargetReal1 val)
01315 {
01316   ffebldConstant c;
01317   ffebldConstant nc;
01318   int cmp;
01319 
01320   for (c = (ffebldConstant) &ffebld_constant_real1_;
01321        c->next != NULL;
01322        c = c->next)
01323     {
01324       cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (c->next));
01325       if (cmp == 0)
01326   return c->next;
01327       if (cmp > 0)
01328   break;
01329     }
01330 
01331   nc = malloc_new_kp (ffebld_constant_pool(),
01332           "FFEBLD_constREAL1",
01333           sizeof (*nc));
01334   nc->next = c->next;
01335   nc->consttype = FFEBLD_constREAL1;
01336   nc->u.real1 = val;
01337 #ifdef FFECOM_constantHOOK
01338   nc->hook = FFECOM_constantNULL;
01339 #endif
01340   c->next = nc;
01341 
01342   return nc;
01343 }
01344 
01345 #endif
01346 /* ffebld_constant_new_real2 -- Return real2 constant object from token
01347 
01348    See prototype.  */
01349 
01350 #if FFETARGET_okREAL2
01351 ffebldConstant
01352 ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal,
01353       ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
01354          ffelexToken exponent_digits)
01355 {
01356   ffetargetReal2 val;
01357 
01358   ffetarget_real2 (&val,
01359       integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
01360   return ffebld_constant_new_real2_val (val);
01361 }
01362 
01363 #endif
01364 /* ffebld_constant_new_real2_val -- Return an real2 constant object
01365 
01366    See prototype.  */
01367 
01368 #if FFETARGET_okREAL2
01369 ffebldConstant
01370 ffebld_constant_new_real2_val (ffetargetReal2 val)
01371 {
01372   ffebldConstant c;
01373   ffebldConstant nc;
01374   int cmp;
01375 
01376   for (c = (ffebldConstant) &ffebld_constant_real2_;
01377        c->next != NULL;
01378        c = c->next)
01379     {
01380       cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (c->next));
01381       if (cmp == 0)
01382   return c->next;
01383       if (cmp > 0)
01384   break;
01385     }
01386 
01387   nc = malloc_new_kp (ffebld_constant_pool(),
01388           "FFEBLD_constREAL2",
01389           sizeof (*nc));
01390   nc->next = c->next;
01391   nc->consttype = FFEBLD_constREAL2;
01392   nc->u.real2 = val;
01393 #ifdef FFECOM_constantHOOK
01394   nc->hook = FFECOM_constantNULL;
01395 #endif
01396   c->next = nc;
01397 
01398   return nc;
01399 }
01400 
01401 #endif
01402 /* ffebld_constant_new_typeless_bm -- Return typeless constant object from token
01403 
01404    See prototype.
01405 
01406    Parses the token as a decimal integer constant, thus it must be an
01407    FFELEX_typeNUMBER.  */
01408 
01409 ffebldConstant
01410 ffebld_constant_new_typeless_bm (ffelexToken t)
01411 {
01412   ffetargetTypeless val;
01413 
01414   ffetarget_binarymil (&val, t);
01415   return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_MIL, val);
01416 }
01417 
01418 /* ffebld_constant_new_typeless_bv -- Return typeless constant object from token
01419 
01420    See prototype.
01421 
01422    Parses the token as a decimal integer constant, thus it must be an
01423    FFELEX_typeNUMBER.  */
01424 
01425 ffebldConstant
01426 ffebld_constant_new_typeless_bv (ffelexToken t)
01427 {
01428   ffetargetTypeless val;
01429 
01430   ffetarget_binaryvxt (&val, t);
01431   return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_VXT, val);
01432 }
01433 
01434 /* ffebld_constant_new_typeless_hxm -- Return typeless constant object from token
01435 
01436    See prototype.
01437 
01438    Parses the token as a decimal integer constant, thus it must be an
01439    FFELEX_typeNUMBER.  */
01440 
01441 ffebldConstant
01442 ffebld_constant_new_typeless_hxm (ffelexToken t)
01443 {
01444   ffetargetTypeless val;
01445 
01446   ffetarget_hexxmil (&val, t);
01447   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_MIL, val);
01448 }
01449 
01450 /* ffebld_constant_new_typeless_hxv -- Return typeless constant object from token
01451 
01452    See prototype.
01453 
01454    Parses the token as a decimal integer constant, thus it must be an
01455    FFELEX_typeNUMBER.  */
01456 
01457 ffebldConstant
01458 ffebld_constant_new_typeless_hxv (ffelexToken t)
01459 {
01460   ffetargetTypeless val;
01461 
01462   ffetarget_hexxvxt (&val, t);
01463   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_VXT, val);
01464 }
01465 
01466 /* ffebld_constant_new_typeless_hzm -- Return typeless constant object from token
01467 
01468    See prototype.
01469 
01470    Parses the token as a decimal integer constant, thus it must be an
01471    FFELEX_typeNUMBER.  */
01472 
01473 ffebldConstant
01474 ffebld_constant_new_typeless_hzm (ffelexToken t)
01475 {
01476   ffetargetTypeless val;
01477 
01478   ffetarget_hexzmil (&val, t);
01479   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_MIL, val);
01480 }
01481 
01482 /* ffebld_constant_new_typeless_hzv -- Return typeless constant object from token
01483 
01484    See prototype.
01485 
01486    Parses the token as a decimal integer constant, thus it must be an
01487    FFELEX_typeNUMBER.  */
01488 
01489 ffebldConstant
01490 ffebld_constant_new_typeless_hzv (ffelexToken t)
01491 {
01492   ffetargetTypeless val;
01493 
01494   ffetarget_hexzvxt (&val, t);
01495   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_VXT, val);
01496 }
01497 
01498 /* ffebld_constant_new_typeless_om -- Return typeless constant object from token
01499 
01500    See prototype.
01501 
01502    Parses the token as a decimal integer constant, thus it must be an
01503    FFELEX_typeNUMBER.  */
01504 
01505 ffebldConstant
01506 ffebld_constant_new_typeless_om (ffelexToken t)
01507 {
01508   ffetargetTypeless val;
01509 
01510   ffetarget_octalmil (&val, t);
01511   return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_MIL, val);
01512 }
01513 
01514 /* ffebld_constant_new_typeless_ov -- Return typeless constant object from token
01515 
01516    See prototype.
01517 
01518    Parses the token as a decimal integer constant, thus it must be an
01519    FFELEX_typeNUMBER.  */
01520 
01521 ffebldConstant
01522 ffebld_constant_new_typeless_ov (ffelexToken t)
01523 {
01524   ffetargetTypeless val;
01525 
01526   ffetarget_octalvxt (&val, t);
01527   return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_VXT, val);
01528 }
01529 
01530 /* ffebld_constant_new_typeless_val -- Return a typeless constant object
01531 
01532    See prototype.  */
01533 
01534 ffebldConstant
01535 ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val)
01536 {
01537   ffebldConstant c;
01538   ffebldConstant nc;
01539   int cmp;
01540 
01541   for (c = (ffebldConstant) &ffebld_constant_typeless_[type
01542                 - FFEBLD_constTYPELESS_FIRST];
01543        c->next != NULL;
01544        c = c->next)
01545     {
01546       cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (c->next));
01547       if (cmp == 0)
01548   return c->next;
01549       if (cmp > 0)
01550   break;
01551     }
01552 
01553   nc = malloc_new_kp (ffebld_constant_pool(),
01554           "FFEBLD_constTYPELESS",
01555           sizeof (*nc));
01556   nc->next = c->next;
01557   nc->consttype = type;
01558   nc->u.typeless = val;
01559 #ifdef FFECOM_constantHOOK
01560   nc->hook = FFECOM_constantNULL;
01561 #endif
01562   c->next = nc;
01563 
01564   return nc;
01565 }
01566 
01567 /* ffebld_constantarray_get -- Get a value from an array of constants
01568 
01569    See prototype.  */
01570 
01571 ffebldConstantUnion
01572 ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
01573         ffeinfoKindtype kt, ffetargetOffset offset)
01574 {
01575   ffebldConstantUnion u;
01576 
01577   switch (bt)
01578     {
01579     case FFEINFO_basictypeINTEGER:
01580       switch (kt)
01581   {
01582 #if FFETARGET_okINTEGER1
01583   case FFEINFO_kindtypeINTEGER1:
01584     u.integer1 = *(array.integer1 + offset);
01585     break;
01586 #endif
01587 
01588 #if FFETARGET_okINTEGER2
01589   case FFEINFO_kindtypeINTEGER2:
01590     u.integer2 = *(array.integer2 + offset);
01591     break;
01592 #endif
01593 
01594 #if FFETARGET_okINTEGER3
01595   case FFEINFO_kindtypeINTEGER3:
01596     u.integer3 = *(array.integer3 + offset);
01597     break;
01598 #endif
01599 
01600 #if FFETARGET_okINTEGER4
01601   case FFEINFO_kindtypeINTEGER4:
01602     u.integer4 = *(array.integer4 + offset);
01603     break;
01604 #endif
01605 
01606 #if FFETARGET_okINTEGER5
01607   case FFEINFO_kindtypeINTEGER5:
01608     u.integer5 = *(array.integer5 + offset);
01609     break;
01610 #endif
01611 
01612 #if FFETARGET_okINTEGER6
01613   case FFEINFO_kindtypeINTEGER6:
01614     u.integer6 = *(array.integer6 + offset);
01615     break;
01616 #endif
01617 
01618 #if FFETARGET_okINTEGER7
01619   case FFEINFO_kindtypeINTEGER7:
01620     u.integer7 = *(array.integer7 + offset);
01621     break;
01622 #endif
01623 
01624 #if FFETARGET_okINTEGER8
01625   case FFEINFO_kindtypeINTEGER8:
01626     u.integer8 = *(array.integer8 + offset);
01627     break;
01628 #endif
01629 
01630   default:
01631     assert ("bad INTEGER kindtype" == NULL);
01632     break;
01633   }
01634       break;
01635 
01636     case FFEINFO_basictypeLOGICAL:
01637       switch (kt)
01638   {
01639 #if FFETARGET_okLOGICAL1
01640   case FFEINFO_kindtypeLOGICAL1:
01641     u.logical1 = *(array.logical1 + offset);
01642     break;
01643 #endif
01644 
01645 #if FFETARGET_okLOGICAL2
01646   case FFEINFO_kindtypeLOGICAL2:
01647     u.logical2 = *(array.logical2 + offset);
01648     break;
01649 #endif
01650 
01651 #if FFETARGET_okLOGICAL3
01652   case FFEINFO_kindtypeLOGICAL3:
01653     u.logical3 = *(array.logical3 + offset);
01654     break;
01655 #endif
01656 
01657 #if FFETARGET_okLOGICAL4
01658   case FFEINFO_kindtypeLOGICAL4:
01659     u.logical4 = *(array.logical4 + offset);
01660     break;
01661 #endif
01662 
01663 #if FFETARGET_okLOGICAL5
01664   case FFEINFO_kindtypeLOGICAL5:
01665     u.logical5 = *(array.logical5 + offset);
01666     break;
01667 #endif
01668 
01669 #if FFETARGET_okLOGICAL6
01670   case FFEINFO_kindtypeLOGICAL6:
01671     u.logical6 = *(array.logical6 + offset);
01672     break;
01673 #endif
01674 
01675 #if FFETARGET_okLOGICAL7
01676   case FFEINFO_kindtypeLOGICAL7:
01677     u.logical7 = *(array.logical7 + offset);
01678     break;
01679 #endif
01680 
01681 #if FFETARGET_okLOGICAL8
01682   case FFEINFO_kindtypeLOGICAL8:
01683     u.logical8 = *(array.logical8 + offset);
01684     break;
01685 #endif
01686 
01687   default:
01688     assert ("bad LOGICAL kindtype" == NULL);
01689     break;
01690   }
01691       break;
01692 
01693     case FFEINFO_basictypeREAL:
01694       switch (kt)
01695   {
01696 #if FFETARGET_okREAL1
01697   case FFEINFO_kindtypeREAL1:
01698     u.real1 = *(array.real1 + offset);
01699     break;
01700 #endif
01701 
01702 #if FFETARGET_okREAL2
01703   case FFEINFO_kindtypeREAL2:
01704     u.real2 = *(array.real2 + offset);
01705     break;
01706 #endif
01707 
01708 #if FFETARGET_okREAL3
01709   case FFEINFO_kindtypeREAL3:
01710     u.real3 = *(array.real3 + offset);
01711     break;
01712 #endif
01713 
01714 #if FFETARGET_okREAL4
01715   case FFEINFO_kindtypeREAL4:
01716     u.real4 = *(array.real4 + offset);
01717     break;
01718 #endif
01719 
01720 #if FFETARGET_okREAL5
01721   case FFEINFO_kindtypeREAL5:
01722     u.real5 = *(array.real5 + offset);
01723     break;
01724 #endif
01725 
01726 #if FFETARGET_okREAL6
01727   case FFEINFO_kindtypeREAL6:
01728     u.real6 = *(array.real6 + offset);
01729     break;
01730 #endif
01731 
01732 #if FFETARGET_okREAL7
01733   case FFEINFO_kindtypeREAL7:
01734     u.real7 = *(array.real7 + offset);
01735     break;
01736 #endif
01737 
01738 #if FFETARGET_okREAL8
01739   case FFEINFO_kindtypeREAL8:
01740     u.real8 = *(array.real8 + offset);
01741     break;
01742 #endif
01743 
01744   default:
01745     assert ("bad REAL kindtype" == NULL);
01746     break;
01747   }
01748       break;
01749 
01750     case FFEINFO_basictypeCOMPLEX:
01751       switch (kt)
01752   {
01753 #if FFETARGET_okCOMPLEX1
01754   case FFEINFO_kindtypeREAL1:
01755     u.complex1 = *(array.complex1 + offset);
01756     break;
01757 #endif
01758 
01759 #if FFETARGET_okCOMPLEX2
01760   case FFEINFO_kindtypeREAL2:
01761     u.complex2 = *(array.complex2 + offset);
01762     break;
01763 #endif
01764 
01765 #if FFETARGET_okCOMPLEX3
01766   case FFEINFO_kindtypeREAL3:
01767     u.complex3 = *(array.complex3 + offset);
01768     break;
01769 #endif
01770 
01771 #if FFETARGET_okCOMPLEX4
01772   case FFEINFO_kindtypeREAL4:
01773     u.complex4 = *(array.complex4 + offset);
01774     break;
01775 #endif
01776 
01777 #if FFETARGET_okCOMPLEX5
01778   case FFEINFO_kindtypeREAL5:
01779     u.complex5 = *(array.complex5 + offset);
01780     break;
01781 #endif
01782 
01783 #if FFETARGET_okCOMPLEX6
01784   case FFEINFO_kindtypeREAL6:
01785     u.complex6 = *(array.complex6 + offset);
01786     break;
01787 #endif
01788 
01789 #if FFETARGET_okCOMPLEX7
01790   case FFEINFO_kindtypeREAL7:
01791     u.complex7 = *(array.complex7 + offset);
01792     break;
01793 #endif
01794 
01795 #if FFETARGET_okCOMPLEX8
01796   case FFEINFO_kindtypeREAL8:
01797     u.complex8 = *(array.complex8 + offset);
01798     break;
01799 #endif
01800 
01801   default:
01802     assert ("bad COMPLEX kindtype" == NULL);
01803     break;
01804   }
01805       break;
01806 
01807     case FFEINFO_basictypeCHARACTER:
01808       switch (kt)
01809   {
01810 #if FFETARGET_okCHARACTER1
01811   case FFEINFO_kindtypeCHARACTER1:
01812     u.character1.length = 1;
01813     u.character1.text = array.character1 + offset;
01814     break;
01815 #endif
01816 
01817 #if FFETARGET_okCHARACTER2
01818   case FFEINFO_kindtypeCHARACTER2:
01819     u.character2.length = 1;
01820     u.character2.text = array.character2 + offset;
01821     break;
01822 #endif
01823 
01824 #if FFETARGET_okCHARACTER3
01825   case FFEINFO_kindtypeCHARACTER3:
01826     u.character3.length = 1;
01827     u.character3.text = array.character3 + offset;
01828     break;
01829 #endif
01830 
01831 #if FFETARGET_okCHARACTER4
01832   case FFEINFO_kindtypeCHARACTER4:
01833     u.character4.length = 1;
01834     u.character4.text = array.character4 + offset;
01835     break;
01836 #endif
01837 
01838 #if FFETARGET_okCHARACTER5
01839   case FFEINFO_kindtypeCHARACTER5:
01840     u.character5.length = 1;
01841     u.character5.text = array.character5 + offset;
01842     break;
01843 #endif
01844 
01845 #if FFETARGET_okCHARACTER6
01846   case FFEINFO_kindtypeCHARACTER6:
01847     u.character6.length = 1;
01848     u.character6.text = array.character6 + offset;
01849     break;
01850 #endif
01851 
01852 #if FFETARGET_okCHARACTER7
01853   case FFEINFO_kindtypeCHARACTER7:
01854     u.character7.length = 1;
01855     u.character7.text = array.character7 + offset;
01856     break;
01857 #endif
01858 
01859 #if FFETARGET_okCHARACTER8
01860   case FFEINFO_kindtypeCHARACTER8:
01861     u.character8.length = 1;
01862     u.character8.text = array.character8 + offset;
01863     break;
01864 #endif
01865 
01866   default:
01867     assert ("bad CHARACTER kindtype" == NULL);
01868     break;
01869   }
01870       break;
01871 
01872     default:
01873       assert ("bad basictype" == NULL);
01874       break;
01875     }
01876 
01877   return u;
01878 }
01879 
01880 /* ffebld_constantarray_new -- Make an array of constants
01881 
01882    See prototype.  */
01883 
01884 ffebldConstantArray
01885 ffebld_constantarray_new (ffeinfoBasictype bt,
01886         ffeinfoKindtype kt, ffetargetOffset size)
01887 {
01888   ffebldConstantArray ptr;
01889 
01890   switch (bt)
01891     {
01892     case FFEINFO_basictypeINTEGER:
01893       switch (kt)
01894   {
01895 #if FFETARGET_okINTEGER1
01896   case FFEINFO_kindtypeINTEGER1:
01897     ptr.integer1 = malloc_new_zkp (ffebld_constant_pool(),
01898            "ffebldConstantArray",
01899            size *= sizeof (ffetargetInteger1),
01900            0);
01901     break;
01902 #endif
01903 
01904 #if FFETARGET_okINTEGER2
01905   case FFEINFO_kindtypeINTEGER2:
01906     ptr.integer2 = malloc_new_zkp (ffebld_constant_pool(),
01907            "ffebldConstantArray",
01908            size *= sizeof (ffetargetInteger2),
01909            0);
01910     break;
01911 #endif
01912 
01913 #if FFETARGET_okINTEGER3
01914   case FFEINFO_kindtypeINTEGER3:
01915     ptr.integer3 = malloc_new_zkp (ffebld_constant_pool(),
01916            "ffebldConstantArray",
01917            size *= sizeof (ffetargetInteger3),
01918            0);
01919     break;
01920 #endif
01921 
01922 #if FFETARGET_okINTEGER4
01923   case FFEINFO_kindtypeINTEGER4:
01924     ptr.integer4 = malloc_new_zkp (ffebld_constant_pool(),
01925            "ffebldConstantArray",
01926            size *= sizeof (ffetargetInteger4),
01927            0);
01928     break;
01929 #endif
01930 
01931 #if FFETARGET_okINTEGER5
01932   case FFEINFO_kindtypeINTEGER5:
01933     ptr.integer5 = malloc_new_zkp (ffebld_constant_pool(),
01934            "ffebldConstantArray",
01935            size *= sizeof (ffetargetInteger5),
01936            0);
01937     break;
01938 #endif
01939 
01940 #if FFETARGET_okINTEGER6
01941   case FFEINFO_kindtypeINTEGER6:
01942     ptr.integer6 = malloc_new_zkp (ffebld_constant_pool(),
01943            "ffebldConstantArray",
01944            size *= sizeof (ffetargetInteger6),
01945            0);
01946     break;
01947 #endif
01948 
01949 #if FFETARGET_okINTEGER7
01950   case FFEINFO_kindtypeINTEGER7:
01951     ptr.integer7 = malloc_new_zkp (ffebld_constant_pool(),
01952            "ffebldConstantArray",
01953            size *= sizeof (ffetargetInteger7),
01954            0);
01955     break;
01956 #endif
01957 
01958 #if FFETARGET_okINTEGER8
01959   case FFEINFO_kindtypeINTEGER8:
01960     ptr.integer8 = malloc_new_zkp (ffebld_constant_pool(),
01961            "ffebldConstantArray",
01962            size *= sizeof (ffetargetInteger8),
01963            0);
01964     break;
01965 #endif
01966 
01967   default:
01968     assert ("bad INTEGER kindtype" == NULL);
01969     break;
01970   }
01971       break;
01972 
01973     case FFEINFO_basictypeLOGICAL:
01974       switch (kt)
01975   {
01976 #if FFETARGET_okLOGICAL1
01977   case FFEINFO_kindtypeLOGICAL1:
01978     ptr.logical1 = malloc_new_zkp (ffebld_constant_pool(),
01979            "ffebldConstantArray",
01980            size *= sizeof (ffetargetLogical1),
01981            0);
01982     break;
01983 #endif
01984 
01985 #if FFETARGET_okLOGICAL2
01986   case FFEINFO_kindtypeLOGICAL2:
01987     ptr.logical2 = malloc_new_zkp (ffebld_constant_pool(),
01988            "ffebldConstantArray",
01989            size *= sizeof (ffetargetLogical2),
01990            0);
01991     break;
01992 #endif
01993 
01994 #if FFETARGET_okLOGICAL3
01995   case FFEINFO_kindtypeLOGICAL3:
01996     ptr.logical3 = malloc_new_zkp (ffebld_constant_pool(),
01997            "ffebldConstantArray",
01998            size *= sizeof (ffetargetLogical3),
01999            0);
02000     break;
02001 #endif
02002 
02003 #if FFETARGET_okLOGICAL4
02004   case FFEINFO_kindtypeLOGICAL4:
02005     ptr.logical4 = malloc_new_zkp (ffebld_constant_pool(),
02006            "ffebldConstantArray",
02007            size *= sizeof (ffetargetLogical4),
02008            0);
02009     break;
02010 #endif
02011 
02012 #if FFETARGET_okLOGICAL5
02013   case FFEINFO_kindtypeLOGICAL5:
02014     ptr.logical5 = malloc_new_zkp (ffebld_constant_pool(),
02015            "ffebldConstantArray",
02016            size *= sizeof (ffetargetLogical5),
02017            0);
02018     break;
02019 #endif
02020 
02021 #if FFETARGET_okLOGICAL6
02022   case FFEINFO_kindtypeLOGICAL6:
02023     ptr.logical6 = malloc_new_zkp (ffebld_constant_pool(),
02024            "ffebldConstantArray",
02025            size *= sizeof (ffetargetLogical6),
02026            0);
02027     break;
02028 #endif
02029 
02030 #if FFETARGET_okLOGICAL7
02031   case FFEINFO_kindtypeLOGICAL7:
02032     ptr.logical7 = malloc_new_zkp (ffebld_constant_pool(),
02033            "ffebldConstantArray",
02034            size *= sizeof (ffetargetLogical7),
02035            0);
02036     break;
02037 #endif
02038 
02039 #if FFETARGET_okLOGICAL8
02040   case FFEINFO_kindtypeLOGICAL8:
02041     ptr.logical8 = malloc_new_zkp (ffebld_constant_pool(),
02042            "ffebldConstantArray",
02043            size *= sizeof (ffetargetLogical8),
02044            0);
02045     break;
02046 #endif
02047 
02048   default:
02049     assert ("bad LOGICAL kindtype" == NULL);
02050     break;
02051   }
02052       break;
02053 
02054     case FFEINFO_basictypeREAL:
02055       switch (kt)
02056   {
02057 #if FFETARGET_okREAL1
02058   case FFEINFO_kindtypeREAL1:
02059     ptr.real1 = malloc_new_zkp (ffebld_constant_pool(),
02060               "ffebldConstantArray",
02061               size *= sizeof (ffetargetReal1),
02062               0);
02063     break;
02064 #endif
02065 
02066 #if FFETARGET_okREAL2
02067   case FFEINFO_kindtypeREAL2:
02068     ptr.real2 = malloc_new_zkp (ffebld_constant_pool(),
02069               "ffebldConstantArray",
02070               size *= sizeof (ffetargetReal2),
02071               0);
02072     break;
02073 #endif
02074 
02075 #if FFETARGET_okREAL3
02076   case FFEINFO_kindtypeREAL3:
02077     ptr.real3 = malloc_new_zkp (ffebld_constant_pool(),
02078               "ffebldConstantArray",
02079               size *= sizeof (ffetargetReal3),
02080               0);
02081     break;
02082 #endif
02083 
02084 #if FFETARGET_okREAL4
02085   case FFEINFO_kindtypeREAL4:
02086     ptr.real4 = malloc_new_zkp (ffebld_constant_pool(),
02087               "ffebldConstantArray",
02088               size *= sizeof (ffetargetReal4),
02089               0);
02090     break;
02091 #endif
02092 
02093 #if FFETARGET_okREAL5
02094   case FFEINFO_kindtypeREAL5:
02095     ptr.real5 = malloc_new_zkp (ffebld_constant_pool(),
02096               "ffebldConstantArray",
02097               size *= sizeof (ffetargetReal5),
02098               0);
02099     break;
02100 #endif
02101 
02102 #if FFETARGET_okREAL6
02103   case FFEINFO_kindtypeREAL6:
02104     ptr.real6 = malloc_new_zkp (ffebld_constant_pool(),
02105               "ffebldConstantArray",
02106               size *= sizeof (ffetargetReal6),
02107               0);
02108     break;
02109 #endif
02110 
02111 #if FFETARGET_okREAL7
02112   case FFEINFO_kindtypeREAL7:
02113     ptr.real7 = malloc_new_zkp (ffebld_constant_pool(),
02114               "ffebldConstantArray",
02115               size *= sizeof (ffetargetReal7),
02116               0);
02117     break;
02118 #endif
02119 
02120 #if FFETARGET_okREAL8
02121   case FFEINFO_kindtypeREAL8:
02122     ptr.real8 = malloc_new_zkp (ffebld_constant_pool(),
02123               "ffebldConstantArray",
02124               size *= sizeof (ffetargetReal8),
02125               0);
02126     break;
02127 #endif
02128 
02129   default:
02130     assert ("bad REAL kindtype" == NULL);
02131     break;
02132   }
02133       break;
02134 
02135     case FFEINFO_basictypeCOMPLEX:
02136       switch (kt)
02137   {
02138 #if FFETARGET_okCOMPLEX1
02139   case FFEINFO_kindtypeREAL1:
02140     ptr.complex1 = malloc_new_zkp (ffebld_constant_pool(),
02141            "ffebldConstantArray",
02142            size *= sizeof (ffetargetComplex1),
02143            0);
02144     break;
02145 #endif
02146 
02147 #if FFETARGET_okCOMPLEX2
02148   case FFEINFO_kindtypeREAL2:
02149     ptr.complex2 = malloc_new_zkp (ffebld_constant_pool(),
02150            "ffebldConstantArray",
02151            size *= sizeof (ffetargetComplex2),
02152            0);
02153     break;
02154 #endif
02155 
02156 #if FFETARGET_okCOMPLEX3
02157   case FFEINFO_kindtypeREAL3:
02158     ptr.complex3 = malloc_new_zkp (ffebld_constant_pool(),
02159            "ffebldConstantArray",
02160            size *= sizeof (ffetargetComplex3),
02161            0);
02162     break;
02163 #endif
02164 
02165 #if FFETARGET_okCOMPLEX4
02166   case FFEINFO_kindtypeREAL4:
02167     ptr.complex4 = malloc_new_zkp (ffebld_constant_pool(),
02168            "ffebldConstantArray",
02169            size *= sizeof (ffetargetComplex4),
02170            0);
02171     break;
02172 #endif
02173 
02174 #if FFETARGET_okCOMPLEX5
02175   case FFEINFO_kindtypeREAL5:
02176     ptr.complex5 = malloc_new_zkp (ffebld_constant_pool(),
02177            "ffebldConstantArray",
02178            size *= sizeof (ffetargetComplex5),
02179            0);
02180     break;
02181 #endif
02182 
02183 #if FFETARGET_okCOMPLEX6
02184   case FFEINFO_kindtypeREAL6:
02185     ptr.complex6 = malloc_new_zkp (ffebld_constant_pool(),
02186            "ffebldConstantArray",
02187            size *= sizeof (ffetargetComplex6),
02188            0);
02189     break;
02190 #endif
02191 
02192 #if FFETARGET_okCOMPLEX7
02193   case FFEINFO_kindtypeREAL7:
02194     ptr.complex7 = malloc_new_zkp (ffebld_constant_pool(),
02195            "ffebldConstantArray",
02196            size *= sizeof (ffetargetComplex7),
02197            0);
02198     break;
02199 #endif
02200 
02201 #if FFETARGET_okCOMPLEX8
02202   case FFEINFO_kindtypeREAL8:
02203     ptr.complex8 = malloc_new_zkp (ffebld_constant_pool(),
02204            "ffebldConstantArray",
02205            size *= sizeof (ffetargetComplex8),
02206            0);
02207     break;
02208 #endif
02209 
02210   default:
02211     assert ("bad COMPLEX kindtype" == NULL);
02212     break;
02213   }
02214       break;
02215 
02216     case FFEINFO_basictypeCHARACTER:
02217       switch (kt)
02218   {
02219 #if FFETARGET_okCHARACTER1
02220   case FFEINFO_kindtypeCHARACTER1:
02221     ptr.character1 = malloc_new_zkp (ffebld_constant_pool(),
02222              "ffebldConstantArray",
02223              size
02224              *= sizeof (ffetargetCharacterUnit1),
02225              0);
02226     break;
02227 #endif
02228 
02229 #if FFETARGET_okCHARACTER2
02230   case FFEINFO_kindtypeCHARACTER2:
02231     ptr.character2 = malloc_new_zkp (ffebld_constant_pool(),
02232              "ffebldConstantArray",
02233              size
02234              *= sizeof (ffetargetCharacterUnit2),
02235              0);
02236     break;
02237 #endif
02238 
02239 #if FFETARGET_okCHARACTER3
02240   case FFEINFO_kindtypeCHARACTER3:
02241     ptr.character3 = malloc_new_zkp (ffebld_constant_pool(),
02242              "ffebldConstantArray",
02243              size
02244              *= sizeof (ffetargetCharacterUnit3),
02245              0);
02246     break;
02247 #endif
02248 
02249 #if FFETARGET_okCHARACTER4
02250   case FFEINFO_kindtypeCHARACTER4:
02251     ptr.character4 = malloc_new_zkp (ffebld_constant_pool(),
02252              "ffebldConstantArray",
02253              size
02254              *= sizeof (ffetargetCharacterUnit4),
02255              0);
02256     break;
02257 #endif
02258 
02259 #if FFETARGET_okCHARACTER5
02260   case FFEINFO_kindtypeCHARACTER5:
02261     ptr.character5 = malloc_new_zkp (ffebld_constant_pool(),
02262              "ffebldConstantArray",
02263              size
02264              *= sizeof (ffetargetCharacterUnit5),
02265              0);
02266     break;
02267 #endif
02268 
02269 #if FFETARGET_okCHARACTER6
02270   case FFEINFO_kindtypeCHARACTER6:
02271     ptr.character6 = malloc_new_zkp (ffebld_constant_pool(),
02272              "ffebldConstantArray",
02273              size
02274              *= sizeof (ffetargetCharacterUnit6),
02275              0);
02276     break;
02277 #endif
02278 
02279 #if FFETARGET_okCHARACTER7
02280   case FFEINFO_kindtypeCHARACTER7:
02281     ptr.character7 = malloc_new_zkp (ffebld_constant_pool(),
02282              "ffebldConstantArray",
02283              size
02284              *= sizeof (ffetargetCharacterUnit7),
02285              0);
02286     break;
02287 #endif
02288 
02289 #if FFETARGET_okCHARACTER8
02290   case FFEINFO_kindtypeCHARACTER8:
02291     ptr.character8 = malloc_new_zkp (ffebld_constant_pool(),
02292              "ffebldConstantArray",
02293              size
02294              *= sizeof (ffetargetCharacterUnit8),
02295              0);
02296     break;
02297 #endif
02298 
02299   default:
02300     assert ("bad CHARACTER kindtype" == NULL);
02301     break;
02302   }
02303       break;
02304 
02305     default:
02306       assert ("bad basictype" == NULL);
02307       break;
02308     }
02309 
02310   return ptr;
02311 }
02312 
02313 /* ffebld_constantarray_preparray -- Prepare for copy between arrays
02314 
02315    See prototype.
02316 
02317    Like _prepare, but the source is an array instead of a single-value
02318    constant.  */
02319 
02320 void
02321 ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
02322        ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
02323        ffetargetOffset offset, ffebldConstantArray source_array,
02324         ffeinfoBasictype cbt, ffeinfoKindtype ckt)
02325 {
02326   switch (abt)
02327     {
02328     case FFEINFO_basictypeINTEGER:
02329       switch (akt)
02330   {
02331 #if FFETARGET_okINTEGER1
02332   case FFEINFO_kindtypeINTEGER1:
02333     *aptr = array.integer1 + offset;
02334     break;
02335 #endif
02336 
02337 #if FFETARGET_okINTEGER2
02338   case FFEINFO_kindtypeINTEGER2:
02339     *aptr = array.integer2 + offset;
02340     break;
02341 #endif
02342 
02343 #if FFETARGET_okINTEGER3
02344   case FFEINFO_kindtypeINTEGER3:
02345     *aptr = array.integer3 + offset;
02346     break;
02347 #endif
02348 
02349 #if FFETARGET_okINTEGER4
02350   case FFEINFO_kindtypeINTEGER4:
02351     *aptr = array.integer4 + offset;
02352     break;
02353 #endif
02354 
02355 #if FFETARGET_okINTEGER5
02356   case FFEINFO_kindtypeINTEGER5:
02357     *aptr = array.integer5 + offset;
02358     break;
02359 #endif
02360 
02361 #if FFETARGET_okINTEGER6
02362   case FFEINFO_kindtypeINTEGER6:
02363     *aptr = array.integer6 + offset;
02364     break;
02365 #endif
02366 
02367 #if FFETARGET_okINTEGER7
02368   case FFEINFO_kindtypeINTEGER7:
02369     *aptr = array.integer7 + offset;
02370     break;
02371 #endif
02372 
02373 #if FFETARGET_okINTEGER8
02374   case FFEINFO_kindtypeINTEGER8:
02375     *aptr = array.integer8 + offset;
02376     break;
02377 #endif
02378 
02379   default:
02380     assert ("bad INTEGER akindtype" == NULL);
02381     break;
02382   }
02383       break;
02384 
02385     case FFEINFO_basictypeLOGICAL:
02386       switch (akt)
02387   {
02388 #if FFETARGET_okLOGICAL1
02389   case FFEINFO_kindtypeLOGICAL1:
02390     *aptr = array.logical1 + offset;
02391     break;
02392 #endif
02393 
02394 #if FFETARGET_okLOGICAL2
02395   case FFEINFO_kindtypeLOGICAL2:
02396     *aptr = array.logical2 + offset;
02397     break;
02398 #endif
02399 
02400 #if FFETARGET_okLOGICAL3
02401   case FFEINFO_kindtypeLOGICAL3:
02402     *aptr = array.logical3 + offset;
02403     break;
02404 #endif
02405 
02406 #if FFETARGET_okLOGICAL4
02407   case FFEINFO_kindtypeLOGICAL4:
02408     *aptr = array.logical4 + offset;
02409     break;
02410 #endif
02411 
02412 #if FFETARGET_okLOGICAL5
02413   case FFEINFO_kindtypeLOGICAL5:
02414     *aptr = array.logical5 + offset;
02415     break;
02416 #endif
02417 
02418 #if FFETARGET_okLOGICAL6
02419   case FFEINFO_kindtypeLOGICAL6:
02420     *aptr = array.logical6 + offset;
02421     break;
02422 #endif
02423 
02424 #if FFETARGET_okLOGICAL7
02425   case FFEINFO_kindtypeLOGICAL7:
02426     *aptr = array.logical7 + offset;
02427     break;
02428 #endif
02429 
02430 #if FFETARGET_okLOGICAL8
02431   case FFEINFO_kindtypeLOGICAL8:
02432     *aptr = array.logical8 + offset;
02433     break;
02434 #endif
02435 
02436   default:
02437     assert ("bad LOGICAL akindtype" == NULL);
02438     break;
02439   }
02440       break;
02441 
02442     case FFEINFO_basictypeREAL:
02443       switch (akt)
02444   {
02445 #if FFETARGET_okREAL1
02446   case FFEINFO_kindtypeREAL1:
02447     *aptr = array.real1 + offset;
02448     break;
02449 #endif
02450 
02451 #if FFETARGET_okREAL2
02452   case FFEINFO_kindtypeREAL2:
02453     *aptr = array.real2 + offset;
02454     break;
02455 #endif
02456 
02457 #if FFETARGET_okREAL3
02458   case FFEINFO_kindtypeREAL3:
02459     *aptr = array.real3 + offset;
02460     break;
02461 #endif
02462 
02463 #if FFETARGET_okREAL4
02464   case FFEINFO_kindtypeREAL4:
02465     *aptr = array.real4 + offset;
02466     break;
02467 #endif
02468 
02469 #if FFETARGET_okREAL5
02470   case FFEINFO_kindtypeREAL5:
02471     *aptr = array.real5 + offset;
02472     break;
02473 #endif
02474 
02475 #if FFETARGET_okREAL6
02476   case FFEINFO_kindtypeREAL6:
02477     *aptr = array.real6 + offset;
02478     break;
02479 #endif
02480 
02481 #if FFETARGET_okREAL7
02482   case FFEINFO_kindtypeREAL7:
02483     *aptr = array.real7 + offset;
02484     break;
02485 #endif
02486 
02487 #if FFETARGET_okREAL8
02488   case FFEINFO_kindtypeREAL8:
02489     *aptr = array.real8 + offset;
02490     break;
02491 #endif
02492 
02493   default:
02494     assert ("bad REAL akindtype" == NULL);
02495     break;
02496   }
02497       break;
02498 
02499     case FFEINFO_basictypeCOMPLEX:
02500       switch (akt)
02501   {
02502 #if FFETARGET_okCOMPLEX1
02503   case FFEINFO_kindtypeREAL1:
02504     *aptr = array.complex1 + offset;
02505     break;
02506 #endif
02507 
02508 #if FFETARGET_okCOMPLEX2
02509   case FFEINFO_kindtypeREAL2:
02510     *aptr = array.complex2 + offset;
02511     break;
02512 #endif
02513 
02514 #if FFETARGET_okCOMPLEX3
02515   case FFEINFO_kindtypeREAL3:
02516     *aptr = array.complex3 + offset;
02517     break;
02518 #endif
02519 
02520 #if FFETARGET_okCOMPLEX4
02521   case FFEINFO_kindtypeREAL4:
02522     *aptr = array.complex4 + offset;
02523     break;
02524 #endif
02525 
02526 #if FFETARGET_okCOMPLEX5
02527   case FFEINFO_kindtypeREAL5:
02528     *aptr = array.complex5 + offset;
02529     break;
02530 #endif
02531 
02532 #if FFETARGET_okCOMPLEX6
02533   case FFEINFO_kindtypeREAL6:
02534     *aptr = array.complex6 + offset;
02535     break;
02536 #endif
02537 
02538 #if FFETARGET_okCOMPLEX7
02539   case FFEINFO_kindtypeREAL7:
02540     *aptr = array.complex7 + offset;
02541     break;
02542 #endif
02543 
02544 #if FFETARGET_okCOMPLEX8
02545   case FFEINFO_kindtypeREAL8:
02546     *aptr = array.complex8 + offset;
02547     break;
02548 #endif
02549 
02550   default:
02551     assert ("bad COMPLEX akindtype" == NULL);
02552     break;
02553   }
02554       break;
02555 
02556     case FFEINFO_basictypeCHARACTER:
02557       switch (akt)
02558   {
02559 #if FFETARGET_okCHARACTER1
02560   case FFEINFO_kindtypeCHARACTER1:
02561     *aptr = array.character1 + offset;
02562     break;
02563 #endif
02564 
02565 #if FFETARGET_okCHARACTER2
02566   case FFEINFO_kindtypeCHARACTER2:
02567     *aptr = array.character2 + offset;
02568     break;
02569 #endif
02570 
02571 #if FFETARGET_okCHARACTER3
02572   case FFEINFO_kindtypeCHARACTER3:
02573     *aptr = array.character3 + offset;
02574     break;
02575 #endif
02576 
02577 #if FFETARGET_okCHARACTER4
02578   case FFEINFO_kindtypeCHARACTER4:
02579     *aptr = array.character4 + offset;
02580     break;
02581 #endif
02582 
02583 #if FFETARGET_okCHARACTER5
02584   case FFEINFO_kindtypeCHARACTER5:
02585     *aptr = array.character5 + offset;
02586     break;
02587 #endif
02588 
02589 #if FFETARGET_okCHARACTER6
02590   case FFEINFO_kindtypeCHARACTER6:
02591     *aptr = array.character6 + offset;
02592     break;
02593 #endif
02594 
02595 #if FFETARGET_okCHARACTER7
02596   case FFEINFO_kindtypeCHARACTER7:
02597     *aptr = array.character7 + offset;
02598     break;
02599 #endif
02600 
02601 #if FFETARGET_okCHARACTER8
02602   case FFEINFO_kindtypeCHARACTER8:
02603     *aptr = array.character8 + offset;
02604     break;
02605 #endif
02606 
02607   default:
02608     assert ("bad CHARACTER akindtype" == NULL);
02609     break;
02610   }
02611       break;
02612 
02613     default:
02614       assert ("bad abasictype" == NULL);
02615       break;
02616     }
02617 
02618   switch (cbt)
02619     {
02620     case FFEINFO_basictypeINTEGER:
02621       switch (ckt)
02622   {
02623 #if FFETARGET_okINTEGER1
02624   case FFEINFO_kindtypeINTEGER1:
02625     *cptr = source_array.integer1;
02626     *size = sizeof (*source_array.integer1);
02627     break;
02628 #endif
02629 
02630 #if FFETARGET_okINTEGER2
02631   case FFEINFO_kindtypeINTEGER2:
02632     *cptr = source_array.integer2;
02633     *size = sizeof (*source_array.integer2);
02634     break;
02635 #endif
02636 
02637 #if FFETARGET_okINTEGER3
02638   case FFEINFO_kindtypeINTEGER3:
02639     *cptr = source_array.integer3;
02640     *size = sizeof (*source_array.integer3);
02641     break;
02642 #endif
02643 
02644 #if FFETARGET_okINTEGER4
02645   case FFEINFO_kindtypeINTEGER4:
02646     *cptr = source_array.integer4;
02647     *size = sizeof (*source_array.integer4);
02648     break;
02649 #endif
02650 
02651 #if FFETARGET_okINTEGER5
02652   case FFEINFO_kindtypeINTEGER5:
02653     *cptr = source_array.integer5;
02654     *size = sizeof (*source_array.integer5);
02655     break;
02656 #endif
02657 
02658 #if FFETARGET_okINTEGER6
02659   case FFEINFO_kindtypeINTEGER6:
02660     *cptr = source_array.integer6;
02661     *size = sizeof (*source_array.integer6);
02662     break;
02663 #endif
02664 
02665 #if FFETARGET_okINTEGER7
02666   case FFEINFO_kindtypeINTEGER7:
02667     *cptr = source_array.integer7;
02668     *size = sizeof (*source_array.integer7);
02669     break;
02670 #endif
02671 
02672 #if FFETARGET_okINTEGER8
02673   case FFEINFO_kindtypeINTEGER8:
02674     *cptr = source_array.integer8;
02675     *size = sizeof (*source_array.integer8);
02676     break;
02677 #endif
02678 
02679   default:
02680     assert ("bad INTEGER ckindtype" == NULL);
02681     break;
02682   }
02683       break;
02684 
02685     case FFEINFO_basictypeLOGICAL:
02686       switch (ckt)
02687   {
02688 #if FFETARGET_okLOGICAL1
02689   case FFEINFO_kindtypeLOGICAL1:
02690     *cptr = source_array.logical1;
02691     *size = sizeof (*source_array.logical1);
02692     break;
02693 #endif
02694 
02695 #if FFETARGET_okLOGICAL2
02696   case FFEINFO_kindtypeLOGICAL2:
02697     *cptr = source_array.logical2;
02698     *size = sizeof (*source_array.logical2);
02699     break;
02700 #endif
02701 
02702 #if FFETARGET_okLOGICAL3
02703   case FFEINFO_kindtypeLOGICAL3:
02704     *cptr = source_array.logical3;
02705     *size = sizeof (*source_array.logical3);
02706     break;
02707 #endif
02708 
02709 #if FFETARGET_okLOGICAL4
02710   case FFEINFO_kindtypeLOGICAL4:
02711     *cptr = source_array.logical4;
02712     *size = sizeof (*source_array.logical4);
02713     break;
02714 #endif
02715 
02716 #if FFETARGET_okLOGICAL5
02717   case FFEINFO_kindtypeLOGICAL5:
02718     *cptr = source_array.logical5;
02719     *size = sizeof (*source_array.logical5);
02720     break;
02721 #endif
02722 
02723 #if FFETARGET_okLOGICAL6
02724   case FFEINFO_kindtypeLOGICAL6:
02725     *cptr = source_array.logical6;
02726     *size = sizeof (*source_array.logical6);
02727     break;
02728 #endif
02729 
02730 #if FFETARGET_okLOGICAL7
02731   case FFEINFO_kindtypeLOGICAL7:
02732     *cptr = source_array.logical7;
02733     *size = sizeof (*source_array.logical7);
02734     break;
02735 #endif
02736 
02737 #if FFETARGET_okLOGICAL8
02738   case FFEINFO_kindtypeLOGICAL8:
02739     *cptr = source_array.logical8;
02740     *size = sizeof (*source_array.logical8);
02741     break;
02742 #endif
02743 
02744   default:
02745     assert ("bad LOGICAL ckindtype" == NULL);
02746     break;
02747   }
02748       break;
02749 
02750     case FFEINFO_basictypeREAL:
02751       switch (ckt)
02752   {
02753 #if FFETARGET_okREAL1
02754   case FFEINFO_kindtypeREAL1:
02755     *cptr = source_array.real1;
02756     *size = sizeof (*source_array.real1);
02757     break;
02758 #endif
02759 
02760 #if FFETARGET_okREAL2
02761   case FFEINFO_kindtypeREAL2:
02762     *cptr = source_array.real2;
02763     *size = sizeof (*source_array.real2);
02764     break;
02765 #endif
02766 
02767 #if FFETARGET_okREAL3
02768   case FFEINFO_kindtypeREAL3:
02769     *cptr = source_array.real3;
02770     *size = sizeof (*source_array.real3);
02771     break;
02772 #endif
02773 
02774 #if FFETARGET_okREAL4
02775   case FFEINFO_kindtypeREAL4:
02776     *cptr = source_array.real4;
02777     *size = sizeof (*source_array.real4);
02778     break;
02779 #endif
02780 
02781 #if FFETARGET_okREAL5
02782   case FFEINFO_kindtypeREAL5:
02783     *cptr = source_array.real5;
02784     *size = sizeof (*source_array.real5);
02785     break;
02786 #endif
02787 
02788 #if FFETARGET_okREAL6
02789   case FFEINFO_kindtypeREAL6:
02790     *cptr = source_array.real6;
02791     *size = sizeof (*source_array.real6);
02792     break;
02793 #endif
02794 
02795 #if FFETARGET_okREAL7
02796   case FFEINFO_kindtypeREAL7:
02797     *cptr = source_array.real7;
02798     *size = sizeof (*source_array.real7);
02799     break;
02800 #endif
02801 
02802 #if FFETARGET_okREAL8
02803   case FFEINFO_kindtypeREAL8:
02804     *cptr = source_array.real8;
02805     *size = sizeof (*source_array.real8);
02806     break;
02807 #endif
02808 
02809   default:
02810     assert ("bad REAL ckindtype" == NULL);
02811     break;
02812   }
02813       break;
02814 
02815     case FFEINFO_basictypeCOMPLEX:
02816       switch (ckt)
02817   {
02818 #if FFETARGET_okCOMPLEX1
02819   case FFEINFO_kindtypeREAL1:
02820     *cptr = source_array.complex1;
02821     *size = sizeof (*source_array.complex1);
02822     break;
02823 #endif
02824 
02825 #if FFETARGET_okCOMPLEX2
02826   case FFEINFO_kindtypeREAL2:
02827     *cptr = source_array.complex2;
02828     *size = sizeof (*source_array.complex2);
02829     break;
02830 #endif
02831 
02832 #if FFETARGET_okCOMPLEX3
02833   case FFEINFO_kindtypeREAL3:
02834     *cptr = source_array.complex3;
02835     *size = sizeof (*source_array.complex3);
02836     break;
02837 #endif
02838 
02839 #if FFETARGET_okCOMPLEX4
02840   case FFEINFO_kindtypeREAL4:
02841     *cptr = source_array.complex4;
02842     *size = sizeof (*source_array.complex4);
02843     break;
02844 #endif
02845 
02846 #if FFETARGET_okCOMPLEX5
02847   case FFEINFO_kindtypeREAL5:
02848     *cptr = source_array.complex5;
02849     *size = sizeof (*source_array.complex5);
02850     break;
02851 #endif
02852 
02853 #if FFETARGET_okCOMPLEX6
02854   case FFEINFO_kindtypeREAL6:
02855     *cptr = source_array.complex6;
02856     *size = sizeof (*source_array.complex6);
02857     break;
02858 #endif
02859 
02860 #if FFETARGET_okCOMPLEX7
02861   case FFEINFO_kindtypeREAL7:
02862     *cptr = source_array.complex7;
02863     *size = sizeof (*source_array.complex7);
02864     break;
02865 #endif
02866 
02867 #if FFETARGET_okCOMPLEX8
02868   case FFEINFO_kindtypeREAL8:
02869     *cptr = source_array.complex8;
02870     *size = sizeof (*source_array.complex8);
02871     break;
02872 #endif
02873 
02874   default:
02875     assert ("bad COMPLEX ckindtype" == NULL);
02876     break;
02877   }
02878       break;
02879 
02880     case FFEINFO_basictypeCHARACTER:
02881       switch (ckt)
02882   {
02883 #if FFETARGET_okCHARACTER1
02884   case FFEINFO_kindtypeCHARACTER1:
02885     *cptr = source_array.character1;
02886     *size = sizeof (*source_array.character1);
02887     break;
02888 #endif
02889 
02890 #if FFETARGET_okCHARACTER2
02891   case FFEINFO_kindtypeCHARACTER2:
02892     *cptr = source_array.character2;
02893     *size = sizeof (*source_array.character2);
02894     break;
02895 #endif
02896 
02897 #if FFETARGET_okCHARACTER3
02898   case FFEINFO_kindtypeCHARACTER3:
02899     *cptr = source_array.character3;
02900     *size = sizeof (*source_array.character3);
02901     break;
02902 #endif
02903 
02904 #if FFETARGET_okCHARACTER4
02905   case FFEINFO_kindtypeCHARACTER4:
02906     *cptr = source_array.character4;
02907     *size = sizeof (*source_array.character4);
02908     break;
02909 #endif
02910 
02911 #if FFETARGET_okCHARACTER5
02912   case FFEINFO_kindtypeCHARACTER5:
02913     *cptr = source_array.character5;
02914     *size = sizeof (*source_array.character5);
02915     break;
02916 #endif
02917 
02918 #if FFETARGET_okCHARACTER6
02919   case FFEINFO_kindtypeCHARACTER6:
02920     *cptr = source_array.character6;
02921     *size = sizeof (*source_array.character6);
02922     break;
02923 #endif
02924 
02925 #if FFETARGET_okCHARACTER7
02926   case FFEINFO_kindtypeCHARACTER7:
02927     *cptr = source_array.character7;
02928     *size = sizeof (*source_array.character7);
02929     break;
02930 #endif
02931 
02932 #if FFETARGET_okCHARACTER8
02933   case FFEINFO_kindtypeCHARACTER8:
02934     *cptr = source_array.character8;
02935     *size = sizeof (*source_array.character8);
02936     break;
02937 #endif
02938 
02939   default:
02940     assert ("bad CHARACTER ckindtype" == NULL);
02941     break;
02942   }
02943       break;
02944 
02945     default:
02946       assert ("bad cbasictype" == NULL);
02947       break;
02948     }
02949 }
02950 
02951 /* ffebld_constantarray_prepare -- Prepare for copy between value and array
02952 
02953    See prototype.
02954 
02955    Like _put, but just returns the pointers to the beginnings of the
02956    array and the constant and returns the size (the amount of info to
02957    copy).  The idea is that the caller can use memcpy to accomplish the
02958    same thing as _put (though slower), or the caller can use a different
02959    function that swaps bytes, words, etc for a different target machine.
02960    Also, the type of the array may be different from the type of the
02961    constant; the array type is used to determine the meaning (scale) of
02962    the offset field (to calculate the array pointer), the constant type is
02963    used to determine the constant pointer and the size (amount of info to
02964    copy).  */
02965 
02966 void
02967 ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
02968        ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
02969           ffetargetOffset offset, ffebldConstantUnion *constant,
02970             ffeinfoBasictype cbt, ffeinfoKindtype ckt)
02971 {
02972   switch (abt)
02973     {
02974     case FFEINFO_basictypeINTEGER:
02975       switch (akt)
02976   {
02977 #if FFETARGET_okINTEGER1
02978   case FFEINFO_kindtypeINTEGER1:
02979     *aptr = array.integer1 + offset;
02980     break;
02981 #endif
02982 
02983 #if FFETARGET_okINTEGER2
02984   case FFEINFO_kindtypeINTEGER2:
02985     *aptr = array.integer2 + offset;
02986     break;
02987 #endif
02988 
02989 #if FFETARGET_okINTEGER3
02990   case FFEINFO_kindtypeINTEGER3:
02991     *aptr = array.integer3 + offset;
02992     break;
02993 #endif
02994 
02995 #if FFETARGET_okINTEGER4
02996   case FFEINFO_kindtypeINTEGER4:
02997     *aptr = array.integer4 + offset;
02998     break;
02999 #endif
03000 
03001 #if FFETARGET_okINTEGER5
03002   case FFEINFO_kindtypeINTEGER5:
03003     *aptr = array.integer5 + offset;
03004     break;
03005 #endif
03006 
03007 #if FFETARGET_okINTEGER6
03008   case FFEINFO_kindtypeINTEGER6:
03009     *aptr = array.integer6 + offset;
03010     break;
03011 #endif
03012 
03013 #if FFETARGET_okINTEGER7
03014   case FFEINFO_kindtypeINTEGER7:
03015     *aptr = array.integer7 + offset;
03016     break;
03017 #endif
03018 
03019 #if FFETARGET_okINTEGER8
03020   case FFEINFO_kindtypeINTEGER8:
03021     *aptr = array.integer8 + offset;
03022     break;
03023 #endif
03024 
03025   default:
03026     assert ("bad INTEGER akindtype" == NULL);
03027     break;
03028   }
03029       break;
03030 
03031     case FFEINFO_basictypeLOGICAL:
03032       switch (akt)
03033   {
03034 #if FFETARGET_okLOGICAL1
03035   case FFEINFO_kindtypeLOGICAL1:
03036     *aptr = array.logical1 + offset;
03037     break;
03038 #endif
03039 
03040 #if FFETARGET_okLOGICAL2
03041   case FFEINFO_kindtypeLOGICAL2:
03042     *aptr = array.logical2 + offset;
03043     break;
03044 #endif
03045 
03046 #if FFETARGET_okLOGICAL3
03047   case FFEINFO_kindtypeLOGICAL3:
03048     *aptr = array.logical3 + offset;
03049     break;
03050 #endif
03051 
03052 #if FFETARGET_okLOGICAL4
03053   case FFEINFO_kindtypeLOGICAL4:
03054     *aptr = array.logical4 + offset;
03055     break;
03056 #endif
03057 
03058 #if FFETARGET_okLOGICAL5
03059   case FFEINFO_kindtypeLOGICAL5:
03060     *aptr = array.logical5 + offset;
03061     break;
03062 #endif
03063 
03064 #if FFETARGET_okLOGICAL6
03065   case FFEINFO_kindtypeLOGICAL6:
03066     *aptr = array.logical6 + offset;
03067     break;
03068 #endif
03069 
03070 #if FFETARGET_okLOGICAL7
03071   case FFEINFO_kindtypeLOGICAL7:
03072     *aptr = array.logical7 + offset;
03073     break;
03074 #endif
03075 
03076 #if FFETARGET_okLOGICAL8
03077   case FFEINFO_kindtypeLOGICAL8:
03078     *aptr = array.logical8 + offset;
03079     break;
03080 #endif
03081 
03082   default:
03083     assert ("bad LOGICAL akindtype" == NULL);
03084     break;
03085   }
03086       break;
03087 
03088     case FFEINFO_basictypeREAL:
03089       switch (akt)
03090   {
03091 #if FFETARGET_okREAL1
03092   case FFEINFO_kindtypeREAL1:
03093     *aptr = array.real1 + offset;
03094     break;
03095 #endif
03096 
03097 #if FFETARGET_okREAL2
03098   case FFEINFO_kindtypeREAL2:
03099     *aptr = array.real2 + offset;
03100     break;
03101 #endif
03102 
03103 #if FFETARGET_okREAL3
03104   case FFEINFO_kindtypeREAL3:
03105     *aptr = array.real3 + offset;
03106     break;
03107 #endif
03108 
03109 #if FFETARGET_okREAL4
03110   case FFEINFO_kindtypeREAL4:
03111     *aptr = array.real4 + offset;
03112     break;
03113 #endif
03114 
03115 #if FFETARGET_okREAL5
03116   case FFEINFO_kindtypeREAL5:
03117     *aptr = array.real5 + offset;
03118     break;
03119 #endif
03120 
03121 #if FFETARGET_okREAL6
03122   case FFEINFO_kindtypeREAL6:
03123     *aptr = array.real6 + offset;
03124     break;
03125 #endif
03126 
03127 #if FFETARGET_okREAL7
03128   case FFEINFO_kindtypeREAL7:
03129     *aptr = array.real7 + offset;
03130     break;
03131 #endif
03132 
03133 #if FFETARGET_okREAL8
03134   case FFEINFO_kindtypeREAL8:
03135     *aptr = array.real8 + offset;
03136     break;
03137 #endif
03138 
03139   default:
03140     assert ("bad REAL akindtype" == NULL);
03141     break;
03142   }
03143       break;
03144 
03145     case FFEINFO_basictypeCOMPLEX:
03146       switch (akt)
03147   {
03148 #if FFETARGET_okCOMPLEX1
03149   case FFEINFO_kindtypeREAL1:
03150     *aptr = array.complex1 + offset;
03151     break;
03152 #endif
03153 
03154 #if FFETARGET_okCOMPLEX2
03155   case FFEINFO_kindtypeREAL2:
03156     *aptr = array.complex2 + offset;
03157     break;
03158 #endif
03159 
03160 #if FFETARGET_okCOMPLEX3
03161   case FFEINFO_kindtypeREAL3:
03162     *aptr = array.complex3 + offset;
03163     break;
03164 #endif
03165 
03166 #if FFETARGET_okCOMPLEX4
03167   case FFEINFO_kindtypeREAL4:
03168     *aptr = array.complex4 + offset;
03169     break;
03170 #endif
03171 
03172 #if FFETARGET_okCOMPLEX5
03173   case FFEINFO_kindtypeREAL5:
03174     *aptr = array.complex5 + offset;
03175     break;
03176 #endif
03177 
03178 #if FFETARGET_okCOMPLEX6
03179   case FFEINFO_kindtypeREAL6:
03180     *aptr = array.complex6 + offset;
03181     break;
03182 #endif
03183 
03184 #if FFETARGET_okCOMPLEX7
03185   case FFEINFO_kindtypeREAL7:
03186     *aptr = array.complex7 + offset;
03187     break;
03188 #endif
03189 
03190 #if FFETARGET_okCOMPLEX8
03191   case FFEINFO_kindtypeREAL8:
03192     *aptr = array.complex8 + offset;
03193     break;
03194 #endif
03195 
03196   default:
03197     assert ("bad COMPLEX akindtype" == NULL);
03198     break;
03199   }
03200       break;
03201 
03202     case FFEINFO_basictypeCHARACTER:
03203       switch (akt)
03204   {
03205 #if FFETARGET_okCHARACTER1
03206   case FFEINFO_kindtypeCHARACTER1:
03207     *aptr = array.character1 + offset;
03208     break;
03209 #endif
03210 
03211 #if FFETARGET_okCHARACTER2
03212   case FFEINFO_kindtypeCHARACTER2:
03213     *aptr = array.character2 + offset;
03214     break;
03215 #endif
03216 
03217 #if FFETARGET_okCHARACTER3
03218   case FFEINFO_kindtypeCHARACTER3:
03219     *aptr = array.character3 + offset;
03220     break;
03221 #endif
03222 
03223 #if FFETARGET_okCHARACTER4
03224   case FFEINFO_kindtypeCHARACTER4:
03225     *aptr = array.character4 + offset;
03226     break;
03227 #endif
03228 
03229 #if FFETARGET_okCHARACTER5
03230   case FFEINFO_kindtypeCHARACTER5:
03231     *aptr = array.character5 + offset;
03232     break;
03233 #endif
03234 
03235 #if FFETARGET_okCHARACTER6
03236   case FFEINFO_kindtypeCHARACTER6:
03237     *aptr = array.character6 + offset;
03238     break;
03239 #endif
03240 
03241 #if FFETARGET_okCHARACTER7
03242   case FFEINFO_kindtypeCHARACTER7:
03243     *aptr = array.character7 + offset;
03244     break;
03245 #endif
03246 
03247 #if FFETARGET_okCHARACTER8
03248   case FFEINFO_kindtypeCHARACTER8:
03249     *aptr = array.character8 + offset;
03250     break;
03251 #endif
03252 
03253   default:
03254     assert ("bad CHARACTER akindtype" == NULL);
03255     break;
03256   }
03257       break;
03258 
03259     default:
03260       assert ("bad abasictype" == NULL);
03261       break;
03262     }
03263 
03264   switch (cbt)
03265     {
03266     case FFEINFO_basictypeINTEGER:
03267       switch (ckt)
03268   {
03269 #if FFETARGET_okINTEGER1
03270   case FFEINFO_kindtypeINTEGER1:
03271     *cptr = &constant->integer1;
03272     *size = sizeof (constant->integer1);
03273     break;
03274 #endif
03275 
03276 #if FFETARGET_okINTEGER2
03277   case FFEINFO_kindtypeINTEGER2:
03278     *cptr = &constant->integer2;
03279     *size = sizeof (constant->integer2);
03280     break;
03281 #endif
03282 
03283 #if FFETARGET_okINTEGER3
03284   case FFEINFO_kindtypeINTEGER3:
03285     *cptr = &constant->integer3;
03286     *size = sizeof (constant->integer3);
03287     break;
03288 #endif
03289 
03290 #if FFETARGET_okINTEGER4
03291   case FFEINFO_kindtypeINTEGER4:
03292     *cptr = &constant->integer4;
03293     *size = sizeof (constant->integer4);
03294     break;
03295 #endif
03296 
03297 #if FFETARGET_okINTEGER5
03298   case FFEINFO_kindtypeINTEGER5:
03299     *cptr = &constant->integer5;
03300     *size = sizeof (constant->integer5);
03301     break;
03302 #endif
03303 
03304 #if FFETARGET_okINTEGER6
03305   case FFEINFO_kindtypeINTEGER6:
03306     *cptr = &constant->integer6;
03307     *size = sizeof (constant->integer6);
03308     break;
03309 #endif
03310 
03311 #if FFETARGET_okINTEGER7
03312   case FFEINFO_kindtypeINTEGER7:
03313     *cptr = &constant->integer7;
03314     *size = sizeof (constant->integer7);
03315     break;
03316 #endif
03317 
03318 #if FFETARGET_okINTEGER8
03319   case FFEINFO_kindtypeINTEGER8:
03320     *cptr = &constant->integer8;
03321     *size = sizeof (constant->integer8);
03322     break;
03323 #endif
03324 
03325   default:
03326     assert ("bad INTEGER ckindtype" == NULL);
03327     break;
03328   }
03329       break;
03330 
03331     case FFEINFO_basictypeLOGICAL:
03332       switch (ckt)
03333   {
03334 #if FFETARGET_okLOGICAL1
03335   case FFEINFO_kindtypeLOGICAL1:
03336     *cptr = &constant->logical1;
03337     *size = sizeof (constant->logical1);
03338     break;
03339 #endif
03340 
03341 #if FFETARGET_okLOGICAL2
03342   case FFEINFO_kindtypeLOGICAL2:
03343     *cptr = &constant->logical2;
03344     *size = sizeof (constant->logical2);
03345     break;
03346 #endif
03347 
03348 #if FFETARGET_okLOGICAL3
03349   case FFEINFO_kindtypeLOGICAL3:
03350     *cptr = &constant->logical3;
03351     *size = sizeof (constant->logical3);
03352     break;
03353 #endif
03354 
03355 #if FFETARGET_okLOGICAL4
03356   case FFEINFO_kindtypeLOGICAL4:
03357     *cptr = &constant->logical4;
03358     *size = sizeof (constant->logical4);
03359     break;
03360 #endif
03361 
03362 #if FFETARGET_okLOGICAL5
03363   case FFEINFO_kindtypeLOGICAL5:
03364     *cptr = &constant->logical5;
03365     *size = sizeof (constant->logical5);
03366     break;
03367 #endif
03368 
03369 #if FFETARGET_okLOGICAL6
03370   case FFEINFO_kindtypeLOGICAL6:
03371     *cptr = &constant->logical6;
03372     *size = sizeof (constant->logical6);
03373     break;
03374 #endif
03375 
03376 #if FFETARGET_okLOGICAL7
03377   case FFEINFO_kindtypeLOGICAL7:
03378     *cptr = &constant->logical7;
03379     *size = sizeof (constant->logical7);
03380     break;
03381 #endif
03382 
03383 #if FFETARGET_okLOGICAL8
03384   case FFEINFO_kindtypeLOGICAL8:
03385     *cptr = &constant->logical8;
03386     *size = sizeof (constant->logical8);
03387     break;
03388 #endif
03389 
03390   default:
03391     assert ("bad LOGICAL ckindtype" == NULL);
03392     break;
03393   }
03394       break;
03395 
03396     case FFEINFO_basictypeREAL:
03397       switch (ckt)
03398   {
03399 #if FFETARGET_okREAL1
03400   case FFEINFO_kindtypeREAL1:
03401     *cptr = &constant->real1;
03402     *size = sizeof (constant->real1);
03403     break;
03404 #endif
03405 
03406 #if FFETARGET_okREAL2
03407   case FFEINFO_kindtypeREAL2:
03408     *cptr = &constant->real2;
03409     *size = sizeof (constant->real2);
03410     break;
03411 #endif
03412 
03413 #if FFETARGET_okREAL3
03414   case FFEINFO_kindtypeREAL3:
03415     *cptr = &constant->real3;
03416     *size = sizeof (constant->real3);
03417     break;
03418 #endif
03419 
03420 #if FFETARGET_okREAL4
03421   case FFEINFO_kindtypeREAL4:
03422     *cptr = &constant->real4;
03423     *size = sizeof (constant->real4);
03424     break;
03425 #endif
03426 
03427 #if FFETARGET_okREAL5
03428   case FFEINFO_kindtypeREAL5:
03429     *cptr = &constant->real5;
03430     *size = sizeof (constant->real5);
03431     break;
03432 #endif
03433 
03434 #if FFETARGET_okREAL6
03435   case FFEINFO_kindtypeREAL6:
03436     *cptr = &constant->real6;
03437     *size = sizeof (constant->real6);
03438     break;
03439 #endif
03440 
03441 #if FFETARGET_okREAL7
03442   case FFEINFO_kindtypeREAL7:
03443     *cptr = &constant->real7;
03444     *size = sizeof (constant->real7);
03445     break;
03446 #endif
03447 
03448 #if FFETARGET_okREAL8
03449   case FFEINFO_kindtypeREAL8:
03450     *cptr = &constant->real8;
03451     *size = sizeof (constant->real8);
03452     break;
03453 #endif
03454 
03455   default:
03456     assert ("bad REAL ckindtype" == NULL);
03457     break;
03458   }
03459       break;
03460 
03461     case FFEINFO_basictypeCOMPLEX:
03462       switch (ckt)
03463   {
03464 #if FFETARGET_okCOMPLEX1
03465   case FFEINFO_kindtypeREAL1:
03466     *cptr = &constant->complex1;
03467     *size = sizeof (constant->complex1);
03468     break;
03469 #endif
03470 
03471 #if FFETARGET_okCOMPLEX2
03472   case FFEINFO_kindtypeREAL2:
03473     *cptr = &constant->complex2;
03474     *size = sizeof (constant->complex2);
03475     break;
03476 #endif
03477 
03478 #if FFETARGET_okCOMPLEX3
03479   case FFEINFO_kindtypeREAL3:
03480     *cptr = &constant->complex3;
03481     *size = sizeof (constant->complex3);
03482     break;
03483 #endif
03484 
03485 #if FFETARGET_okCOMPLEX4
03486   case FFEINFO_kindtypeREAL4:
03487     *cptr = &constant->complex4;
03488     *size = sizeof (constant->complex4);
03489     break;
03490 #endif
03491 
03492 #if FFETARGET_okCOMPLEX5
03493   case FFEINFO_kindtypeREAL5:
03494     *cptr = &constant->complex5;
03495     *size = sizeof (constant->complex5);
03496     break;
03497 #endif
03498 
03499 #if FFETARGET_okCOMPLEX6
03500   case FFEINFO_kindtypeREAL6:
03501     *cptr = &constant->complex6;
03502     *size = sizeof (constant->complex6);
03503     break;
03504 #endif
03505 
03506 #if FFETARGET_okCOMPLEX7
03507   case FFEINFO_kindtypeREAL7:
03508     *cptr = &constant->complex7;
03509     *size = sizeof (constant->complex7);
03510     break;
03511 #endif
03512 
03513 #if FFETARGET_okCOMPLEX8
03514   case FFEINFO_kindtypeREAL8:
03515     *cptr = &constant->complex8;
03516     *size = sizeof (constant->complex8);
03517     break;
03518 #endif
03519 
03520   default:
03521     assert ("bad COMPLEX ckindtype" == NULL);
03522     break;
03523   }
03524       break;
03525 
03526     case FFEINFO_basictypeCHARACTER:
03527       switch (ckt)
03528   {
03529 #if FFETARGET_okCHARACTER1
03530   case FFEINFO_kindtypeCHARACTER1:
03531     *cptr = ffetarget_text_character1 (constant->character1);
03532     *size = ffetarget_length_character1 (constant->character1);
03533     break;
03534 #endif
03535 
03536 #if FFETARGET_okCHARACTER2
03537   case FFEINFO_kindtypeCHARACTER2:
03538     *cptr = ffetarget_text_character2 (constant->character2);
03539     *size = ffetarget_length_character2 (constant->character2);
03540     break;
03541 #endif
03542 
03543 #if FFETARGET_okCHARACTER3
03544   case FFEINFO_kindtypeCHARACTER3:
03545     *cptr = ffetarget_text_character3 (constant->character3);
03546     *size = ffetarget_length_character3 (constant->character3);
03547     break;
03548 #endif
03549 
03550 #if FFETARGET_okCHARACTER4
03551   case FFEINFO_kindtypeCHARACTER4:
03552     *cptr = ffetarget_text_character4 (constant->character4);
03553     *size = ffetarget_length_character4 (constant->character4);
03554     break;
03555 #endif
03556 
03557 #if FFETARGET_okCHARACTER5
03558   case FFEINFO_kindtypeCHARACTER5:
03559     *cptr = ffetarget_text_character5 (constant->character5);
03560     *size = ffetarget_length_character5 (constant->character5);
03561     break;
03562 #endif
03563 
03564 #if FFETARGET_okCHARACTER6
03565   case FFEINFO_kindtypeCHARACTER6:
03566     *cptr = ffetarget_text_character6 (constant->character6);
03567     *size = ffetarget_length_character6 (constant->character6);
03568     break;
03569 #endif
03570 
03571 #if FFETARGET_okCHARACTER7
03572   case FFEINFO_kindtypeCHARACTER7:
03573     *cptr = ffetarget_text_character7 (constant->character7);
03574     *size = ffetarget_length_character7 (constant->character7);
03575     break;
03576 #endif
03577 
03578 #if FFETARGET_okCHARACTER8
03579   case FFEINFO_kindtypeCHARACTER8:
03580     *cptr = ffetarget_text_character8 (constant->character8);
03581     *size = ffetarget_length_character8 (constant->character8);
03582     break;
03583 #endif
03584 
03585   default:
03586     assert ("bad CHARACTER ckindtype" == NULL);
03587     break;
03588   }
03589       break;
03590 
03591     default:
03592       assert ("bad cbasictype" == NULL);
03593       break;
03594     }
03595 }
03596 
03597 /* ffebld_constantarray_put -- Put a value into an array of constants
03598 
03599    See prototype.  */
03600 
03601 void
03602 ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
03603    ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant)
03604 {
03605   switch (bt)
03606     {
03607     case FFEINFO_basictypeINTEGER:
03608       switch (kt)
03609   {
03610 #if FFETARGET_okINTEGER1
03611   case FFEINFO_kindtypeINTEGER1:
03612     *(array.integer1 + offset) = constant.integer1;
03613     break;
03614 #endif
03615 
03616 #if FFETARGET_okINTEGER2
03617   case FFEINFO_kindtypeINTEGER2:
03618     *(array.integer2 + offset) = constant.integer2;
03619     break;
03620 #endif
03621 
03622 #if FFETARGET_okINTEGER3
03623   case FFEINFO_kindtypeINTEGER3:
03624     *(array.integer3 + offset) = constant.integer3;
03625     break;
03626 #endif
03627 
03628 #if FFETARGET_okINTEGER4
03629   case FFEINFO_kindtypeINTEGER4:
03630     *(array.integer4 + offset) = constant.integer4;
03631     break;
03632 #endif
03633 
03634 #if FFETARGET_okINTEGER5
03635   case FFEINFO_kindtypeINTEGER5:
03636     *(array.integer5 + offset) = constant.integer5;
03637     break;
03638 #endif
03639 
03640 #if FFETARGET_okINTEGER6
03641   case FFEINFO_kindtypeINTEGER6:
03642     *(array.integer6 + offset) = constant.integer6;
03643     break;
03644 #endif
03645 
03646 #if FFETARGET_okINTEGER7
03647   case FFEINFO_kindtypeINTEGER7:
03648     *(array.integer7 + offset) = constant.integer7;
03649     break;
03650 #endif
03651 
03652 #if FFETARGET_okINTEGER8
03653   case FFEINFO_kindtypeINTEGER8:
03654     *(array.integer8 + offset) = constant.integer8;
03655     break;
03656 #endif
03657 
03658   default:
03659     assert ("bad INTEGER kindtype" == NULL);
03660     break;
03661   }
03662       break;
03663 
03664     case FFEINFO_basictypeLOGICAL:
03665       switch (kt)
03666   {
03667 #if FFETARGET_okLOGICAL1
03668   case FFEINFO_kindtypeLOGICAL1:
03669     *(array.logical1 + offset) = constant.logical1;
03670     break;
03671 #endif
03672 
03673 #if FFETARGET_okLOGICAL2
03674   case FFEINFO_kindtypeLOGICAL2:
03675     *(array.logical2 + offset) = constant.logical2;
03676     break;
03677 #endif
03678 
03679 #if FFETARGET_okLOGICAL3
03680   case FFEINFO_kindtypeLOGICAL3:
03681     *(array.logical3 + offset) = constant.logical3;
03682     break;
03683 #endif
03684 
03685 #if FFETARGET_okLOGICAL4
03686   case FFEINFO_kindtypeLOGICAL4:
03687     *(array.logical4 + offset) = constant.logical4;
03688     break;
03689 #endif
03690 
03691 #if FFETARGET_okLOGICAL5
03692   case FFEINFO_kindtypeLOGICAL5:
03693     *(array.logical5 + offset) = constant.logical5;
03694     break;
03695 #endif
03696 
03697 #if FFETARGET_okLOGICAL6
03698   case FFEINFO_kindtypeLOGICAL6:
03699     *(array.logical6 + offset) = constant.logical6;
03700     break;
03701 #endif
03702 
03703 #if FFETARGET_okLOGICAL7
03704   case FFEINFO_kindtypeLOGICAL7:
03705     *(array.logical7 + offset) = constant.logical7;
03706     break;
03707 #endif
03708 
03709 #if FFETARGET_okLOGICAL8
03710   case FFEINFO_kindtypeLOGICAL8:
03711     *(array.logical8 + offset) = constant.logical8;
03712     break;
03713 #endif
03714 
03715   default:
03716     assert ("bad LOGICAL kindtype" == NULL);
03717     break;
03718   }
03719       break;
03720 
03721     case FFEINFO_basictypeREAL:
03722       switch (kt)
03723   {
03724 #if FFETARGET_okREAL1
03725   case FFEINFO_kindtypeREAL1:
03726     *(array.real1 + offset) = constant.real1;
03727     break;
03728 #endif
03729 
03730 #if FFETARGET_okREAL2
03731   case FFEINFO_kindtypeREAL2:
03732     *(array.real2 + offset) = constant.real2;
03733     break;
03734 #endif
03735 
03736 #if FFETARGET_okREAL3
03737   case FFEINFO_kindtypeREAL3:
03738     *(array.real3 + offset) = constant.real3;
03739     break;
03740 #endif
03741 
03742 #if FFETARGET_okREAL4
03743   case FFEINFO_kindtypeREAL4:
03744     *(array.real4 + offset) = constant.real4;
03745     break;
03746 #endif
03747 
03748 #if FFETARGET_okREAL5
03749   case FFEINFO_kindtypeREAL5:
03750     *(array.real5 + offset) = constant.real5;
03751     break;
03752 #endif
03753 
03754 #if FFETARGET_okREAL6
03755   case FFEINFO_kindtypeREAL6:
03756     *(array.real6 + offset) = constant.real6;
03757     break;
03758 #endif
03759 
03760 #if FFETARGET_okREAL7
03761   case FFEINFO_kindtypeREAL7:
03762     *(array.real7 + offset) = constant.real7;
03763     break;
03764 #endif
03765 
03766 #if FFETARGET_okREAL8
03767   case FFEINFO_kindtypeREAL8:
03768     *(array.real8 + offset) = constant.real8;
03769     break;
03770 #endif
03771 
03772   default:
03773     assert ("bad REAL kindtype" == NULL);
03774     break;
03775   }
03776       break;
03777 
03778     case FFEINFO_basictypeCOMPLEX:
03779       switch (kt)
03780   {
03781 #if FFETARGET_okCOMPLEX1
03782   case FFEINFO_kindtypeREAL1:
03783     *(array.complex1 + offset) = constant.complex1;
03784     break;
03785 #endif
03786 
03787 #if FFETARGET_okCOMPLEX2
03788   case FFEINFO_kindtypeREAL2:
03789     *(array.complex2 + offset) = constant.complex2;
03790     break;
03791 #endif
03792 
03793 #if FFETARGET_okCOMPLEX3
03794   case FFEINFO_kindtypeREAL3:
03795     *(array.complex3 + offset) = constant.complex3;
03796     break;
03797 #endif
03798 
03799 #if FFETARGET_okCOMPLEX4
03800   case FFEINFO_kindtypeREAL4:
03801     *(array.complex4 + offset) = constant.complex4;
03802     break;
03803 #endif
03804 
03805 #if FFETARGET_okCOMPLEX5
03806   case FFEINFO_kindtypeREAL5:
03807     *(array.complex5 + offset) = constant.complex5;
03808     break;
03809 #endif
03810 
03811 #if FFETARGET_okCOMPLEX6
03812   case FFEINFO_kindtypeREAL6:
03813     *(array.complex6 + offset) = constant.complex6;
03814     break;
03815 #endif
03816 
03817 #if FFETARGET_okCOMPLEX7
03818   case FFEINFO_kindtypeREAL7:
03819     *(array.complex7 + offset) = constant.complex7;
03820     break;
03821 #endif
03822 
03823 #if FFETARGET_okCOMPLEX8
03824   case FFEINFO_kindtypeREAL8:
03825     *(array.complex8 + offset) = constant.complex8;
03826     break;
03827 #endif
03828 
03829   default:
03830     assert ("bad COMPLEX kindtype" == NULL);
03831     break;
03832   }
03833       break;
03834 
03835     case FFEINFO_basictypeCHARACTER:
03836       switch (kt)
03837   {
03838 #if FFETARGET_okCHARACTER1
03839   case FFEINFO_kindtypeCHARACTER1:
03840     memcpy (array.character1 + offset,
03841       ffetarget_text_character1 (constant.character1),
03842       ffetarget_length_character1 (constant.character1));
03843     break;
03844 #endif
03845 
03846 #if FFETARGET_okCHARACTER2
03847   case FFEINFO_kindtypeCHARACTER2:
03848     memcpy (array.character2 + offset,
03849       ffetarget_text_character2 (constant.character2),
03850       ffetarget_length_character2 (constant.character2));
03851     break;
03852 #endif
03853 
03854 #if FFETARGET_okCHARACTER3
03855   case FFEINFO_kindtypeCHARACTER3:
03856     memcpy (array.character3 + offset,
03857       ffetarget_text_character3 (constant.character3),
03858       ffetarget_length_character3 (constant.character3));
03859     break;
03860 #endif
03861 
03862 #if FFETARGET_okCHARACTER4
03863   case FFEINFO_kindtypeCHARACTER4:
03864     memcpy (array.character4 + offset,
03865       ffetarget_text_character4 (constant.character4),
03866       ffetarget_length_character4 (constant.character4));
03867     break;
03868 #endif
03869 
03870 #if FFETARGET_okCHARACTER5
03871   case FFEINFO_kindtypeCHARACTER5:
03872     memcpy (array.character5 + offset,
03873       ffetarget_text_character5 (constant.character5),
03874       ffetarget_length_character5 (constant.character5));
03875     break;
03876 #endif
03877 
03878 #if FFETARGET_okCHARACTER6
03879   case FFEINFO_kindtypeCHARACTER6:
03880     memcpy (array.character6 + offset,
03881       ffetarget_text_character6 (constant.character6),
03882       ffetarget_length_character6 (constant.character6));
03883     break;
03884 #endif
03885 
03886 #if FFETARGET_okCHARACTER7
03887   case FFEINFO_kindtypeCHARACTER7:
03888     memcpy (array.character7 + offset,
03889       ffetarget_text_character7 (constant.character7),
03890       ffetarget_length_character7 (constant.character7));
03891     break;
03892 #endif
03893 
03894 #if FFETARGET_okCHARACTER8
03895   case FFEINFO_kindtypeCHARACTER8:
03896     memcpy (array.character8 + offset,
03897       ffetarget_text_character8 (constant.character8),
03898       ffetarget_length_character8 (constant.character8));
03899     break;
03900 #endif
03901 
03902   default:
03903     assert ("bad CHARACTER kindtype" == NULL);
03904     break;
03905   }
03906       break;
03907 
03908     default:
03909       assert ("bad basictype" == NULL);
03910       break;
03911     }
03912 }
03913 
03914 /* ffebld_init_0 -- Initialize the module
03915 
03916    ffebld_init_0();  */
03917 
03918 void
03919 ffebld_init_0 ()
03920 {
03921   assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_));
03922   assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_));
03923 }
03924 
03925 /* ffebld_init_1 -- Initialize the module for a file
03926 
03927    ffebld_init_1();  */
03928 
03929 void
03930 ffebld_init_1 ()
03931 {
03932 #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
03933   int i;
03934 
03935 #if FFETARGET_okCHARACTER1
03936   ffebld_constant_character1_ = NULL;
03937 #endif
03938 #if FFETARGET_okCHARACTER2
03939   ffebld_constant_character2_ = NULL;
03940 #endif
03941 #if FFETARGET_okCHARACTER3
03942   ffebld_constant_character3_ = NULL;
03943 #endif
03944 #if FFETARGET_okCHARACTER4
03945   ffebld_constant_character4_ = NULL;
03946 #endif
03947 #if FFETARGET_okCHARACTER5
03948   ffebld_constant_character5_ = NULL;
03949 #endif
03950 #if FFETARGET_okCHARACTER6
03951   ffebld_constant_character6_ = NULL;
03952 #endif
03953 #if FFETARGET_okCHARACTER7
03954   ffebld_constant_character7_ = NULL;
03955 #endif
03956 #if FFETARGET_okCHARACTER8
03957   ffebld_constant_character8_ = NULL;
03958 #endif
03959 #if FFETARGET_okCOMPLEX1
03960   ffebld_constant_complex1_ = NULL;
03961 #endif
03962 #if FFETARGET_okCOMPLEX2
03963   ffebld_constant_complex2_ = NULL;
03964 #endif
03965 #if FFETARGET_okCOMPLEX3
03966   ffebld_constant_complex3_ = NULL;
03967 #endif
03968 #if FFETARGET_okCOMPLEX4
03969   ffebld_constant_complex4_ = NULL;
03970 #endif
03971 #if FFETARGET_okCOMPLEX5
03972   ffebld_constant_complex5_ = NULL;
03973 #endif
03974 #if FFETARGET_okCOMPLEX6
03975   ffebld_constant_complex6_ = NULL;
03976 #endif
03977 #if FFETARGET_okCOMPLEX7
03978   ffebld_constant_complex7_ = NULL;
03979 #endif
03980 #if FFETARGET_okCOMPLEX8
03981   ffebld_constant_complex8_ = NULL;
03982 #endif
03983 #if FFETARGET_okINTEGER1
03984   ffebld_constant_integer1_ = NULL;
03985 #endif
03986 #if FFETARGET_okINTEGER2
03987   ffebld_constant_integer2_ = NULL;
03988 #endif
03989 #if FFETARGET_okINTEGER3
03990   ffebld_constant_integer3_ = NULL;
03991 #endif
03992 #if FFETARGET_okINTEGER4
03993   ffebld_constant_integer4_ = NULL;
03994 #endif
03995 #if FFETARGET_okINTEGER5
03996   ffebld_constant_integer5_ = NULL;
03997 #endif
03998 #if FFETARGET_okINTEGER6
03999   ffebld_constant_integer6_ = NULL;
04000 #endif
04001 #if FFETARGET_okINTEGER7
04002   ffebld_constant_integer7_ = NULL;
04003 #endif
04004 #if FFETARGET_okINTEGER8
04005   ffebld_constant_integer8_ = NULL;
04006 #endif
04007 #if FFETARGET_okLOGICAL1
04008   ffebld_constant_logical1_ = NULL;
04009 #endif
04010 #if FFETARGET_okLOGICAL2
04011   ffebld_constant_logical2_ = NULL;
04012 #endif
04013 #if FFETARGET_okLOGICAL3
04014   ffebld_constant_logical3_ = NULL;
04015 #endif
04016 #if FFETARGET_okLOGICAL4
04017   ffebld_constant_logical4_ = NULL;
04018 #endif
04019 #if FFETARGET_okLOGICAL5
04020   ffebld_constant_logical5_ = NULL;
04021 #endif
04022 #if FFETARGET_okLOGICAL6
04023   ffebld_constant_logical6_ = NULL;
04024 #endif
04025 #if FFETARGET_okLOGICAL7
04026   ffebld_constant_logical7_ = NULL;
04027 #endif
04028 #if FFETARGET_okLOGICAL8
04029   ffebld_constant_logical8_ = NULL;
04030 #endif
04031 #if FFETARGET_okREAL1
04032   ffebld_constant_real1_ = NULL;
04033 #endif
04034 #if FFETARGET_okREAL2
04035   ffebld_constant_real2_ = NULL;
04036 #endif
04037 #if FFETARGET_okREAL3
04038   ffebld_constant_real3_ = NULL;
04039 #endif
04040 #if FFETARGET_okREAL4
04041   ffebld_constant_real4_ = NULL;
04042 #endif
04043 #if FFETARGET_okREAL5
04044   ffebld_constant_real5_ = NULL;
04045 #endif
04046 #if FFETARGET_okREAL6
04047   ffebld_constant_real6_ = NULL;
04048 #endif
04049 #if FFETARGET_okREAL7
04050   ffebld_constant_real7_ = NULL;
04051 #endif
04052 #if FFETARGET_okREAL8
04053   ffebld_constant_real8_ = NULL;
04054 #endif
04055   ffebld_constant_hollerith_ = NULL;
04056   for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
04057     ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
04058 #endif
04059 }
04060 
04061 /* ffebld_init_2 -- Initialize the module
04062 
04063    ffebld_init_2();  */
04064 
04065 void
04066 ffebld_init_2 ()
04067 {
04068 #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
04069   int i;
04070 #endif
04071 
04072   ffebld_pool_stack_.next = NULL;
04073   ffebld_pool_stack_.pool = ffe_pool_program_unit ();
04074 #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
04075 #if FFETARGET_okCHARACTER1
04076   ffebld_constant_character1_ = NULL;
04077 #endif
04078 #if FFETARGET_okCHARACTER2
04079   ffebld_constant_character2_ = NULL;
04080 #endif
04081 #if FFETARGET_okCHARACTER3
04082   ffebld_constant_character3_ = NULL;
04083 #endif
04084 #if FFETARGET_okCHARACTER4
04085   ffebld_constant_character4_ = NULL;
04086 #endif
04087 #if FFETARGET_okCHARACTER5
04088   ffebld_constant_character5_ = NULL;
04089 #endif
04090 #if FFETARGET_okCHARACTER6
04091   ffebld_constant_character6_ = NULL;
04092 #endif
04093 #if FFETARGET_okCHARACTER7
04094   ffebld_constant_character7_ = NULL;
04095 #endif
04096 #if FFETARGET_okCHARACTER8
04097   ffebld_constant_character8_ = NULL;
04098 #endif
04099 #if FFETARGET_okCOMPLEX1
04100   ffebld_constant_complex1_ = NULL;
04101 #endif
04102 #if FFETARGET_okCOMPLEX2
04103   ffebld_constant_complex2_ = NULL;
04104 #endif
04105 #if FFETARGET_okCOMPLEX3
04106   ffebld_constant_complex3_ = NULL;
04107 #endif
04108 #if FFETARGET_okCOMPLEX4
04109   ffebld_constant_complex4_ = NULL;
04110 #endif
04111 #if FFETARGET_okCOMPLEX5
04112   ffebld_constant_complex5_ = NULL;
04113 #endif
04114 #if FFETARGET_okCOMPLEX6
04115   ffebld_constant_complex6_ = NULL;
04116 #endif
04117 #if FFETARGET_okCOMPLEX7
04118   ffebld_constant_complex7_ = NULL;
04119 #endif
04120 #if FFETARGET_okCOMPLEX8
04121   ffebld_constant_complex8_ = NULL;
04122 #endif
04123 #if FFETARGET_okINTEGER1
04124   ffebld_constant_integer1_ = NULL;
04125 #endif
04126 #if FFETARGET_okINTEGER2
04127   ffebld_constant_integer2_ = NULL;
04128 #endif
04129 #if FFETARGET_okINTEGER3
04130   ffebld_constant_integer3_ = NULL;
04131 #endif
04132 #if FFETARGET_okINTEGER4
04133   ffebld_constant_integer4_ = NULL;
04134 #endif
04135 #if FFETARGET_okINTEGER5
04136   ffebld_constant_integer5_ = NULL;
04137 #endif
04138 #if FFETARGET_okINTEGER6
04139   ffebld_constant_integer6_ = NULL;
04140 #endif
04141 #if FFETARGET_okINTEGER7
04142   ffebld_constant_integer7_ = NULL;
04143 #endif
04144 #if FFETARGET_okINTEGER8
04145   ffebld_constant_integer8_ = NULL;
04146 #endif
04147 #if FFETARGET_okLOGICAL1
04148   ffebld_constant_logical1_ = NULL;
04149 #endif
04150 #if FFETARGET_okLOGICAL2
04151   ffebld_constant_logical2_ = NULL;
04152 #endif
04153 #if FFETARGET_okLOGICAL3
04154   ffebld_constant_logical3_ = NULL;
04155 #endif
04156 #if FFETARGET_okLOGICAL4
04157   ffebld_constant_logical4_ = NULL;
04158 #endif
04159 #if FFETARGET_okLOGICAL5
04160   ffebld_constant_logical5_ = NULL;
04161 #endif
04162 #if FFETARGET_okLOGICAL6
04163   ffebld_constant_logical6_ = NULL;
04164 #endif
04165 #if FFETARGET_okLOGICAL7
04166   ffebld_constant_logical7_ = NULL;
04167 #endif
04168 #if FFETARGET_okLOGICAL8
04169   ffebld_constant_logical8_ = NULL;
04170 #endif
04171 #if FFETARGET_okREAL1
04172   ffebld_constant_real1_ = NULL;
04173 #endif
04174 #if FFETARGET_okREAL2
04175   ffebld_constant_real2_ = NULL;
04176 #endif
04177 #if FFETARGET_okREAL3
04178   ffebld_constant_real3_ = NULL;
04179 #endif
04180 #if FFETARGET_okREAL4
04181   ffebld_constant_real4_ = NULL;
04182 #endif
04183 #if FFETARGET_okREAL5
04184   ffebld_constant_real5_ = NULL;
04185 #endif
04186 #if FFETARGET_okREAL6
04187   ffebld_constant_real6_ = NULL;
04188 #endif
04189 #if FFETARGET_okREAL7
04190   ffebld_constant_real7_ = NULL;
04191 #endif
04192 #if FFETARGET_okREAL8
04193   ffebld_constant_real8_ = NULL;
04194 #endif
04195   ffebld_constant_hollerith_ = NULL;
04196   for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
04197     ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
04198 #endif
04199 }
04200 
04201 /* ffebld_list_length -- Return # of opITEMs in list
04202 
04203    ffebld list;  // Must be NULL or opITEM
04204    ffebldListLength length;
04205    length = ffebld_list_length(list);
04206 
04207    Returns 0 if list is NULL, 1 if it's ffebld_trail is NULL, and so on.  */
04208 
04209 ffebldListLength
04210 ffebld_list_length (ffebld list)
04211 {
04212   ffebldListLength length;
04213 
04214   for (length = 0; list != NULL; ++length, list = ffebld_trail (list))
04215     ;
04216 
04217   return length;
04218 }
04219 
04220 /* ffebld_new_accter -- Create an ffebld object that is an array
04221 
04222    ffebld x;
04223    ffebldConstantArray a;
04224    ffebit b;
04225    x = ffebld_new_accter(a,b);  */
04226 
04227 ffebld
04228 ffebld_new_accter (ffebldConstantArray a, ffebit b)
04229 {
04230   ffebld x;
04231 
04232   x = ffebld_new ();
04233 #if FFEBLD_BLANK_
04234   *x = ffebld_blank_;
04235 #endif
04236   x->op = FFEBLD_opACCTER;
04237   x->u.accter.array = a;
04238   x->u.accter.bits = b;
04239   x->u.accter.pad = 0;
04240   return x;
04241 }
04242 
04243 /* ffebld_new_arrter -- Create an ffebld object that is an array
04244 
04245    ffebld x;
04246    ffebldConstantArray a;
04247    ffetargetOffset size;
04248    x = ffebld_new_arrter(a,size);  */
04249 
04250 ffebld
04251 ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
04252 {
04253   ffebld x;
04254 
04255   x = ffebld_new ();
04256 #if FFEBLD_BLANK_
04257   *x = ffebld_blank_;
04258 #endif
04259   x->op = FFEBLD_opARRTER;
04260   x->u.arrter.array = a;
04261   x->u.arrter.size = size;
04262   x->u.arrter.pad = 0;
04263   return x;
04264 }
04265 
04266 /* ffebld_new_conter_with_orig -- Create an ffebld object that is a constant
04267 
04268    ffebld x;
04269    ffebldConstant c;
04270    x = ffebld_new_conter_with_orig(c,NULL);  */
04271 
04272 ffebld
04273 ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
04274 {
04275   ffebld x;
04276 
04277   x = ffebld_new ();
04278 #if FFEBLD_BLANK_
04279   *x = ffebld_blank_;
04280 #endif
04281   x->op = FFEBLD_opCONTER;
04282   x->u.conter.expr = c;
04283   x->u.conter.orig = o;
04284   x->u.conter.pad = 0;
04285   return x;
04286 }
04287 
04288 /* ffebld_new_item -- Create an ffebld item object
04289 
04290    ffebld x,y,z;
04291    x = ffebld_new_item(y,z);  */
04292 
04293 ffebld
04294 ffebld_new_item (ffebld head, ffebld trail)
04295 {
04296   ffebld x;
04297 
04298   x = ffebld_new ();
04299 #if FFEBLD_BLANK_
04300   *x = ffebld_blank_;
04301 #endif
04302   x->op = FFEBLD_opITEM;
04303   x->u.item.head = head;
04304   x->u.item.trail = trail;
04305 #ifdef FFECOM_itemHOOK
04306   x->u.item.hook = FFECOM_itemNULL;
04307 #endif
04308   return x;
04309 }
04310 
04311 /* ffebld_new_labter -- Create an ffebld object that is a label
04312 
04313    ffebld x;
04314    ffelab l;
04315    x = ffebld_new_labter(c);  */
04316 
04317 ffebld
04318 ffebld_new_labter (ffelab l)
04319 {
04320   ffebld x;
04321 
04322   x = ffebld_new ();
04323 #if FFEBLD_BLANK_
04324   *x = ffebld_blank_;
04325 #endif
04326   x->op = FFEBLD_opLABTER;
04327   x->u.labter = l;
04328   return x;
04329 }
04330 
04331 /* ffebld_new_labtok -- Create object that is a label's NUMBER token
04332 
04333    ffebld x;
04334    ffelexToken t;
04335    x = ffebld_new_labter(c);
04336 
04337    Like the other ffebld_new_ functions, the
04338    supplied argument is stored exactly as is: ffelex_token_use is NOT
04339    called, so the token is "consumed", if one is indeed supplied (it may
04340    be NULL).  */
04341 
04342 ffebld
04343 ffebld_new_labtok (ffelexToken t)
04344 {
04345   ffebld x;
04346 
04347   x = ffebld_new ();
04348 #if FFEBLD_BLANK_
04349   *x = ffebld_blank_;
04350 #endif
04351   x->op = FFEBLD_opLABTOK;
04352   x->u.labtok = t;
04353   return x;
04354 }
04355 
04356 /* ffebld_new_none -- Create an ffebld object with no arguments
04357 
04358    ffebld x;
04359    x = ffebld_new_none(FFEBLD_opWHATEVER);  */
04360 
04361 ffebld
04362 ffebld_new_none (ffebldOp o)
04363 {
04364   ffebld x;
04365 
04366   x = ffebld_new ();
04367 #if FFEBLD_BLANK_
04368   *x = ffebld_blank_;
04369 #endif
04370   x->op = o;
04371   return x;
04372 }
04373 
04374 /* ffebld_new_one -- Create an ffebld object with one argument
04375 
04376    ffebld x,y;
04377    x = ffebld_new_one(FFEBLD_opWHATEVER,y);  */
04378 
04379 ffebld
04380 ffebld_new_one (ffebldOp o, ffebld left)
04381 {
04382   ffebld x;
04383 
04384   x = ffebld_new ();
04385 #if FFEBLD_BLANK_
04386   *x = ffebld_blank_;
04387 #endif
04388   x->op = o;
04389   x->u.nonter.left = left;
04390 #ifdef FFECOM_nonterHOOK
04391   x->u.nonter.hook = FFECOM_nonterNULL;
04392 #endif
04393   return x;
04394 }
04395 
04396 /* ffebld_new_symter -- Create an ffebld object that is a symbol
04397 
04398    ffebld x;
04399    ffesymbol s;
04400    ffeintrinGen gen;  // Generic intrinsic id, if any
04401    ffeintrinSpec spec;  // Specific intrinsic id, if any
04402    ffeintrinImp imp;  // Implementation intrinsic id, if any
04403    x = ffebld_new_symter (s, gen, spec, imp);  */
04404 
04405 ffebld
04406 ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
04407        ffeintrinImp imp)
04408 {
04409   ffebld x;
04410 
04411   x = ffebld_new ();
04412 #if FFEBLD_BLANK_
04413   *x = ffebld_blank_;
04414 #endif
04415   x->op = FFEBLD_opSYMTER;
04416   x->u.symter.symbol = s;
04417   x->u.symter.generic = gen;
04418   x->u.symter.specific = spec;
04419   x->u.symter.implementation = imp;
04420   x->u.symter.do_iter = FALSE;
04421   return x;
04422 }
04423 
04424 /* ffebld_new_two -- Create an ffebld object with two arguments
04425 
04426    ffebld x,y,z;
04427    x = ffebld_new_two(FFEBLD_opWHATEVER,y,z);  */
04428 
04429 ffebld
04430 ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
04431 {
04432   ffebld x;
04433 
04434   x = ffebld_new ();
04435 #if FFEBLD_BLANK_
04436   *x = ffebld_blank_;
04437 #endif
04438   x->op = o;
04439   x->u.nonter.left = left;
04440   x->u.nonter.right = right;
04441 #ifdef FFECOM_nonterHOOK
04442   x->u.nonter.hook = FFECOM_nonterNULL;
04443 #endif
04444   return x;
04445 }
04446 
04447 /* ffebld_pool_pop -- Pop ffebld's pool stack
04448 
04449    ffebld_pool_pop();  */
04450 
04451 void
04452 ffebld_pool_pop ()
04453 {
04454   ffebldPoolstack_ ps;
04455 
04456   assert (ffebld_pool_stack_.next != NULL);
04457   ps = ffebld_pool_stack_.next;
04458   ffebld_pool_stack_.next = ps->next;
04459   ffebld_pool_stack_.pool = ps->pool;
04460   malloc_kill_ks (malloc_pool_image (), ps, sizeof (*ps));
04461 }
04462 
04463 /* ffebld_pool_push -- Push ffebld's pool stack
04464 
04465    ffebld_pool_push();  */
04466 
04467 void
04468 ffebld_pool_push (mallocPool pool)
04469 {
04470   ffebldPoolstack_ ps;
04471 
04472   ps = malloc_new_ks (malloc_pool_image (), "Pool stack", sizeof (*ps));
04473   ps->next = ffebld_pool_stack_.next;
04474   ps->pool = ffebld_pool_stack_.pool;
04475   ffebld_pool_stack_.next = ps;
04476   ffebld_pool_stack_.pool = pool;
04477 }
04478 
04479 /* ffebld_op_string -- Return short string describing op
04480 
04481    ffebldOp o;
04482    ffebld_op_string(o);
04483 
04484    Returns a short string (uppercase) containing the name of the op.  */
04485 
04486 const char *
04487 ffebld_op_string (ffebldOp o)
04488 {
04489   if (o >= ARRAY_SIZE (ffebld_op_string_))
04490     return "?\?\?";
04491   return ffebld_op_string_[o];
04492 }
04493 
04494 /* ffebld_size_max -- Return maximum possible size of CHARACTER-type expr
04495 
04496    ffetargetCharacterSize sz;
04497    ffebld b;
04498    sz = ffebld_size_max (b);
04499 
04500    Like ffebld_size_known, but if that would return NONE and the expression
04501    is opSUBSTR, opCONVERT, opPAREN, or opCONCATENATE, returns ffebld_size_max
04502    of the subexpression(s).  */
04503 
04504 ffetargetCharacterSize
04505 ffebld_size_max (ffebld b)
04506 {
04507   ffetargetCharacterSize sz;
04508 
04509 recurse:      /* :::::::::::::::::::: */
04510 
04511   sz = ffebld_size_known (b);
04512 
04513   if (sz != FFETARGET_charactersizeNONE)
04514     return sz;
04515 
04516   switch (ffebld_op (b))
04517     {
04518     case FFEBLD_opSUBSTR:
04519     case FFEBLD_opCONVERT:
04520     case FFEBLD_opPAREN:
04521       b = ffebld_left (b);
04522       goto recurse;   /* :::::::::::::::::::: */
04523 
04524     case FFEBLD_opCONCATENATE:
04525       sz = ffebld_size_max (ffebld_left (b))
04526   + ffebld_size_max (ffebld_right (b));
04527       return sz;
04528 
04529     default:
04530       return sz;
04531     }
04532 }