home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / g77-0.5.15-src.tgz / tar.out / fsf / g77 / f / bld.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  125KB  |  5,503 lines
  1. /* bld.c -- Implementation File (module.c template V1.0)
  2.    Copyright (C) 1995 Free Software Foundation, Inc.
  3.    Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
  4.  
  5. This file is part of GNU Fortran.
  6.  
  7. GNU Fortran is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2, or (at your option)
  10. any later version.
  11.  
  12. GNU Fortran is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with GNU Fortran; see the file COPYING.  If not, write to
  19. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.    Related Modules:
  22.       None
  23.  
  24.    Description:
  25.       The primary "output" of the FFE includes ffebld objects, which
  26.       connect expressions, operators, and operands together, along with
  27.       connecting lists of expressions together for argument or dimension
  28.       lists.
  29.  
  30.    Modifications:
  31.       30-Aug-92     JCB  1.1
  32.      Change names of some things for consistency.
  33. */
  34.  
  35. /* Include files. */
  36.  
  37. #include "proj.h"
  38. #include <ctype.h>
  39. #include "bld.h"
  40. #include "bit.h"
  41. #include "info.h"
  42. #include "lex.h"
  43. #include "malloc.h"
  44. #include "target.h"
  45. #include "where.h"
  46.  
  47. /* Externals defined here.  */
  48.  
  49. ffebldArity ffebld_arity_op_[]
  50. =
  51. {
  52. #define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
  53. #include "bld-op.def"
  54. #undef FFEBLD_OP
  55. };
  56. struct _ffebld_pool_stack_ ffebld_pool_stack_;
  57.  
  58. /* Simple definitions and enumerations. */
  59.  
  60.  
  61. /* Internal typedefs. */
  62.  
  63.  
  64. /* Private include files. */
  65.  
  66.  
  67. /* Internal structure definitions. */
  68.  
  69.  
  70. /* Static objects accessed by functions in this module.     */
  71.  
  72. #if FFEBLD_BLANK_
  73. static struct _ffebld_ ffebld_blank_
  74. =
  75. {
  76.   0,
  77.   {FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, FFEINFO_kindNONE,
  78.    FFEINFO_whereNONE, FFETARGET_charactersizeNONE},
  79.   {NULL, NULL}
  80. };
  81. #endif
  82. #if FFETARGET_okCHARACTER1
  83. static ffebldConstant ffebld_constant_character1_;
  84. #endif
  85. #if FFETARGET_okCHARACTER2
  86. static ffebldConstant ffebld_constant_character2_;
  87. #endif
  88. #if FFETARGET_okCHARACTER3
  89. static ffebldConstant ffebld_constant_character3_;
  90. #endif
  91. #if FFETARGET_okCHARACTER4
  92. static ffebldConstant ffebld_constant_character4_;
  93. #endif
  94. #if FFETARGET_okCHARACTER5
  95. static ffebldConstant ffebld_constant_character5_;
  96. #endif
  97. #if FFETARGET_okCHARACTER6
  98. static ffebldConstant ffebld_constant_character6_;
  99. #endif
  100. #if FFETARGET_okCHARACTER7
  101. static ffebldConstant ffebld_constant_character7_;
  102. #endif
  103. #if FFETARGET_okCHARACTER8
  104. static ffebldConstant ffebld_constant_character8_;
  105. #endif
  106. #if FFETARGET_okCOMPLEX1
  107. static ffebldConstant ffebld_constant_complex1_;
  108. #endif
  109. #if FFETARGET_okCOMPLEX2
  110. static ffebldConstant ffebld_constant_complex2_;
  111. #endif
  112. #if FFETARGET_okCOMPLEX3
  113. static ffebldConstant ffebld_constant_complex3_;
  114. #endif
  115. #if FFETARGET_okCOMPLEX4
  116. static ffebldConstant ffebld_constant_complex4_;
  117. #endif
  118. #if FFETARGET_okCOMPLEX5
  119. static ffebldConstant ffebld_constant_complex5_;
  120. #endif
  121. #if FFETARGET_okCOMPLEX6
  122. static ffebldConstant ffebld_constant_complex6_;
  123. #endif
  124. #if FFETARGET_okCOMPLEX7
  125. static ffebldConstant ffebld_constant_complex7_;
  126. #endif
  127. #if FFETARGET_okCOMPLEX8
  128. static ffebldConstant ffebld_constant_complex8_;
  129. #endif
  130. #if FFETARGET_okINTEGER1
  131. static ffebldConstant ffebld_constant_integer1_;
  132. #endif
  133. #if FFETARGET_okINTEGER2
  134. static ffebldConstant ffebld_constant_integer2_;
  135. #endif
  136. #if FFETARGET_okINTEGER3
  137. static ffebldConstant ffebld_constant_integer3_;
  138. #endif
  139. #if FFETARGET_okINTEGER4
  140. static ffebldConstant ffebld_constant_integer4_;
  141. #endif
  142. #if FFETARGET_okINTEGER5
  143. static ffebldConstant ffebld_constant_integer5_;
  144. #endif
  145. #if FFETARGET_okINTEGER6
  146. static ffebldConstant ffebld_constant_integer6_;
  147. #endif
  148. #if FFETARGET_okINTEGER7
  149. static ffebldConstant ffebld_constant_integer7_;
  150. #endif
  151. #if FFETARGET_okINTEGER8
  152. static ffebldConstant ffebld_constant_integer8_;
  153. #endif
  154. #if FFETARGET_okLOGICAL1
  155. static ffebldConstant ffebld_constant_logical1_;
  156. #endif
  157. #if FFETARGET_okLOGICAL2
  158. static ffebldConstant ffebld_constant_logical2_;
  159. #endif
  160. #if FFETARGET_okLOGICAL3
  161. static ffebldConstant ffebld_constant_logical3_;
  162. #endif
  163. #if FFETARGET_okLOGICAL4
  164. static ffebldConstant ffebld_constant_logical4_;
  165. #endif
  166. #if FFETARGET_okLOGICAL5
  167. static ffebldConstant ffebld_constant_logical5_;
  168. #endif
  169. #if FFETARGET_okLOGICAL6
  170. static ffebldConstant ffebld_constant_logical6_;
  171. #endif
  172. #if FFETARGET_okLOGICAL7
  173. static ffebldConstant ffebld_constant_logical7_;
  174. #endif
  175. #if FFETARGET_okLOGICAL8
  176. static ffebldConstant ffebld_constant_logical8_;
  177. #endif
  178. #if FFETARGET_okREAL1
  179. static ffebldConstant ffebld_constant_real1_;
  180. #endif
  181. #if FFETARGET_okREAL2
  182. static ffebldConstant ffebld_constant_real2_;
  183. #endif
  184. #if FFETARGET_okREAL3
  185. static ffebldConstant ffebld_constant_real3_;
  186. #endif
  187. #if FFETARGET_okREAL4
  188. static ffebldConstant ffebld_constant_real4_;
  189. #endif
  190. #if FFETARGET_okREAL5
  191. static ffebldConstant ffebld_constant_real5_;
  192. #endif
  193. #if FFETARGET_okREAL6
  194. static ffebldConstant ffebld_constant_real6_;
  195. #endif
  196. #if FFETARGET_okREAL7
  197. static ffebldConstant ffebld_constant_real7_;
  198. #endif
  199. #if FFETARGET_okREAL8
  200. static ffebldConstant ffebld_constant_real8_;
  201. #endif
  202. static ffebldConstant ffebld_constant_hollerith_;
  203. static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
  204.                       - FFEBLD_constTYPELESS_FIRST + 1];
  205.  
  206. static char *ffebld_op_string_[]
  207. =
  208. {
  209. #define FFEBLD_OP(KWD,NAME,ARITY) NAME,
  210. #include "bld-op.def"
  211. #undef FFEBLD_OP
  212. };
  213.  
  214. /* Static functions (internal). */
  215.  
  216.  
  217. /* Internal macros. */
  218.  
  219. #define integerdefault_ CATX(integer,FFETARGET_ktINTEGERDEFAULT)
  220. #define logicaldefault_ CATX(logical,FFETARGET_ktLOGICALDEFAULT)
  221. #define realdefault_ CATX(real,FFETARGET_ktREALDEFAULT)
  222. #define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE)
  223. #define realquad_ CATX(real,FFETARGET_ktREALQUAD)
  224.  
  225. #define FFEBLD_whereconstPROGUNIT_ 0
  226. #define FFEBLD_whereconstFILE_ 1
  227.  
  228. #if FFECOM_targetCURRENT == FFECOM_targetFFE
  229. #define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstPROGUNIT_
  230. #else
  231. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  232. #define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_
  233. #endif
  234. #endif
  235.  
  236. #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
  237. #define FFEBLD_CONSTANT_POOL_ ffe_pool_program_unit()
  238. #else
  239. #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
  240. #define FFEBLD_CONSTANT_POOL_ ffe_pool_file()
  241. #endif
  242. #endif
  243.  
  244. /* ffebld_constant_cmp -- Compare two constants a la strcmp
  245.  
  246.    ffebldConstant c1, c2;
  247.    if (ffebld_constant_cmp(c1,c2) == 0)
  248.        // they're equal, else they're not.
  249.  
  250.    Returns -1 if c1 < c2, 0 if c1 == c2, +1 if c1 == c2.  */
  251.  
  252. int
  253. ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2)
  254. {
  255.   if (c1 == c2)
  256.     return 0;
  257.  
  258.   assert (ffebld_constant_type (c1) == ffebld_constant_type (c2));
  259.  
  260.   switch (ffebld_constant_type (c1))
  261.     {
  262. #if FFETARGET_okINTEGER1
  263.     case FFEBLD_constINTEGER1:
  264.       return ffetarget_cmp_integer1 (ffebld_constant_integer1 (c1),
  265.                      ffebld_constant_integer1 (c2));
  266. #endif
  267.  
  268. #if FFETARGET_okINTEGER2
  269.     case FFEBLD_constINTEGER2:
  270.       return ffetarget_cmp_integer2 (ffebld_constant_integer2 (c1),
  271.                      ffebld_constant_integer2 (c2));
  272. #endif
  273.  
  274. #if FFETARGET_okINTEGER3
  275.     case FFEBLD_constINTEGER3:
  276.       return ffetarget_cmp_integer3 (ffebld_constant_integer3 (c1),
  277.                      ffebld_constant_integer3 (c2));
  278. #endif
  279.  
  280. #if FFETARGET_okINTEGER4
  281.     case FFEBLD_constINTEGER4:
  282.       return ffetarget_cmp_integer4 (ffebld_constant_integer4 (c1),
  283.                      ffebld_constant_integer4 (c2));
  284. #endif
  285.  
  286. #if FFETARGET_okINTEGER5
  287.     case FFEBLD_constINTEGER5:
  288.       return ffetarget_cmp_integer5 (ffebld_constant_integer5 (c1),
  289.                      ffebld_constant_integer5 (c2));
  290. #endif
  291.  
  292. #if FFETARGET_okINTEGER6
  293.     case FFEBLD_constINTEGER6:
  294.       return ffetarget_cmp_integer6 (ffebld_constant_integer6 (c1),
  295.                      ffebld_constant_integer6 (c2));
  296. #endif
  297.  
  298. #if FFETARGET_okINTEGER7
  299.     case FFEBLD_constINTEGER7:
  300.       return ffetarget_cmp_integer7 (ffebld_constant_integer7 (c1),
  301.                      ffebld_constant_integer7 (c2));
  302. #endif
  303.  
  304. #if FFETARGET_okINTEGER8
  305.     case FFEBLD_constINTEGER8:
  306.       return ffetarget_cmp_integer8 (ffebld_constant_integer8 (c1),
  307.                      ffebld_constant_integer8 (c2));
  308. #endif
  309.  
  310. #if FFETARGET_okLOGICAL1
  311.     case FFEBLD_constLOGICAL1:
  312.       return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
  313.                      ffebld_constant_logical1 (c2));
  314. #endif
  315.  
  316. #if FFETARGET_okLOGICAL2
  317.     case FFEBLD_constLOGICAL2:
  318.       return ffetarget_cmp_logical2 (ffebld_constant_logical2 (c1),
  319.                      ffebld_constant_logical2 (c2));
  320. #endif
  321.  
  322. #if FFETARGET_okLOGICAL3
  323.     case FFEBLD_constLOGICAL3:
  324.       return ffetarget_cmp_logical3 (ffebld_constant_logical3 (c1),
  325.                      ffebld_constant_logical3 (c2));
  326. #endif
  327.  
  328. #if FFETARGET_okLOGICAL4
  329.     case FFEBLD_constLOGICAL4:
  330.       return ffetarget_cmp_logical4 (ffebld_constant_logical4 (c1),
  331.                      ffebld_constant_logical4 (c2));
  332. #endif
  333.  
  334. #if FFETARGET_okLOGICAL5
  335.     case FFEBLD_constLOGICAL5:
  336.       return ffetarget_cmp_logical5 (ffebld_constant_logical5 (c1),
  337.                      ffebld_constant_logical5 (c2));
  338. #endif
  339.  
  340. #if FFETARGET_okLOGICAL6
  341.     case FFEBLD_constLOGICAL6:
  342.       return ffetarget_cmp_logical6 (ffebld_constant_logical6 (c1),
  343.                      ffebld_constant_logical6 (c2));
  344. #endif
  345.  
  346. #if FFETARGET_okLOGICAL7
  347.     case FFEBLD_constLOGICAL7:
  348.       return ffetarget_cmp_logical7 (ffebld_constant_logical7 (c1),
  349.                      ffebld_constant_logical7 (c2));
  350. #endif
  351.  
  352. #if FFETARGET_okLOGICAL8
  353.     case FFEBLD_constLOGICAL8:
  354.       return ffetarget_cmp_logical8 (ffebld_constant_logical8 (c1),
  355.                      ffebld_constant_logical8 (c2));
  356. #endif
  357.  
  358. #if FFETARGET_okREAL1
  359.     case FFEBLD_constREAL1:
  360.       return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
  361.                   ffebld_constant_real1 (c2));
  362. #endif
  363.  
  364. #if FFETARGET_okREAL2
  365.     case FFEBLD_constREAL2:
  366.       return ffetarget_cmp_real2 (ffebld_constant_real2 (c1),
  367.                   ffebld_constant_real2 (c2));
  368. #endif
  369.  
  370. #if FFETARGET_okREAL3
  371.     case FFEBLD_constREAL3:
  372.       return ffetarget_cmp_real3 (ffebld_constant_real3 (c1),
  373.                   ffebld_constant_real3 (c2));
  374. #endif
  375.  
  376. #if FFETARGET_okREAL4
  377.     case FFEBLD_constREAL4:
  378.       return ffetarget_cmp_real4 (ffebld_constant_real4 (c1),
  379.                   ffebld_constant_real4 (c2));
  380. #endif
  381.  
  382. #if FFETARGET_okREAL5
  383.     case FFEBLD_constREAL5:
  384.       return ffetarget_cmp_real5 (ffebld_constant_real5 (c1),
  385.                   ffebld_constant_real5 (c2));
  386. #endif
  387.  
  388. #if FFETARGET_okREAL6
  389.     case FFEBLD_constREAL6:
  390.       return ffetarget_cmp_real6 (ffebld_constant_real6 (c1),
  391.                   ffebld_constant_real6 (c2));
  392. #endif
  393.  
  394. #if FFETARGET_okREAL7
  395.     case FFEBLD_constREAL7:
  396.       return ffetarget_cmp_real7 (ffebld_constant_real7 (c1),
  397.                   ffebld_constant_real7 (c2));
  398. #endif
  399.  
  400. #if FFETARGET_okREAL8
  401.     case FFEBLD_constREAL8:
  402.       return ffetarget_cmp_real8 (ffebld_constant_real8 (c1),
  403.                   ffebld_constant_real8 (c2));
  404. #endif
  405.  
  406. #if FFETARGET_okCHARACTER1
  407.     case FFEBLD_constCHARACTER1:
  408.       return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
  409.                        ffebld_constant_character1 (c2));
  410. #endif
  411.  
  412. #if FFETARGET_okCHARACTER2
  413.     case FFEBLD_constCHARACTER2:
  414.       return ffetarget_cmp_character2 (ffebld_constant_character2 (c1),
  415.                        ffebld_constant_character2 (c2));
  416. #endif
  417.  
  418. #if FFETARGET_okCHARACTER3
  419.     case FFEBLD_constCHARACTER3:
  420.       return ffetarget_cmp_character3 (ffebld_constant_character3 (c1),
  421.                        ffebld_constant_character3 (c2));
  422. #endif
  423.  
  424. #if FFETARGET_okCHARACTER4
  425.     case FFEBLD_constCHARACTER4:
  426.       return ffetarget_cmp_character4 (ffebld_constant_character4 (c1),
  427.                        ffebld_constant_character4 (c2));
  428. #endif
  429.  
  430. #if FFETARGET_okCHARACTER5
  431.     case FFEBLD_constCHARACTER5:
  432.       return ffetarget_cmp_character5 (ffebld_constant_character5 (c1),
  433.                        ffebld_constant_character5 (c2));
  434. #endif
  435.  
  436. #if FFETARGET_okCHARACTER6
  437.     case FFEBLD_constCHARACTER6:
  438.       return ffetarget_cmp_character6 (ffebld_constant_character6 (c1),
  439.                        ffebld_constant_character6 (c2));
  440. #endif
  441.  
  442. #if FFETARGET_okCHARACTER7
  443.     case FFEBLD_constCHARACTER7:
  444.       return ffetarget_cmp_character7 (ffebld_constant_character7 (c1),
  445.                        ffebld_constant_character7 (c2));
  446. #endif
  447.  
  448. #if FFETARGET_okCHARACTER8
  449.     case FFEBLD_constCHARACTER8:
  450.       return ffetarget_cmp_character8 (ffebld_constant_character8 (c1),
  451.                        ffebld_constant_character8 (c2));
  452. #endif
  453.  
  454.     default:
  455.       assert ("bad constant type" == NULL);
  456.       return 0;
  457.     }
  458. }
  459.  
  460. /* ffebld_constant_dump -- Display summary of constant's contents
  461.  
  462.    ffebldConstant c;
  463.    ffebld_constant_dump(c);
  464.  
  465.    Displays the constant in summary form.  */
  466.  
  467. void
  468. ffebld_constant_dump (ffebldConstant c)
  469. {
  470.   switch (ffebld_constant_type (c))
  471.     {
  472. #if FFETARGET_okINTEGER1
  473.     case FFEBLD_constINTEGER1:
  474.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  475.               FFEINFO_kindtypeINTEGER1);
  476.       ffebld_constantunion_dump (ffebld_constant_union (c),
  477.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1);
  478.       break;
  479. #endif
  480.  
  481. #if FFETARGET_okINTEGER2
  482.     case FFEBLD_constINTEGER2:
  483.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  484.               FFEINFO_kindtypeINTEGER2);
  485.       ffebld_constantunion_dump (ffebld_constant_union (c),
  486.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2);
  487.       break;
  488. #endif
  489.  
  490. #if FFETARGET_okINTEGER3
  491.     case FFEBLD_constINTEGER3:
  492.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  493.               FFEINFO_kindtypeINTEGER3);
  494.       ffebld_constantunion_dump (ffebld_constant_union (c),
  495.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3);
  496.       break;
  497. #endif
  498.  
  499. #if FFETARGET_okINTEGER4
  500.     case FFEBLD_constINTEGER4:
  501.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  502.               FFEINFO_kindtypeINTEGER4);
  503.       ffebld_constantunion_dump (ffebld_constant_union (c),
  504.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4);
  505.       break;
  506. #endif
  507.  
  508. #if FFETARGET_okINTEGER5
  509.     case FFEBLD_constINTEGER5:
  510.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  511.               FFEINFO_kindtypeINTEGER5);
  512.       ffebld_constantunion_dump (ffebld_constant_union (c),
  513.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER5);
  514.       break;
  515. #endif
  516.  
  517. #if FFETARGET_okINTEGER6
  518.     case FFEBLD_constINTEGER6:
  519.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  520.               FFEINFO_kindtypeINTEGER6);
  521.       ffebld_constantunion_dump (ffebld_constant_union (c),
  522.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER6);
  523.       break;
  524. #endif
  525.  
  526. #if FFETARGET_okINTEGER7
  527.     case FFEBLD_constINTEGER7:
  528.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  529.               FFEINFO_kindtypeINTEGER7);
  530.       ffebld_constantunion_dump (ffebld_constant_union (c),
  531.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER7);
  532.       break;
  533. #endif
  534.  
  535. #if FFETARGET_okINTEGER8
  536.     case FFEBLD_constINTEGER8:
  537.       ffebld_dump_prefix (stdout, FFEINFO_basictypeINTEGER,
  538.               FFEINFO_kindtypeINTEGER8);
  539.       ffebld_constantunion_dump (ffebld_constant_union (c),
  540.             FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER8);
  541.       break;
  542. #endif
  543.  
  544. #if FFETARGET_okLOGICAL1
  545.     case FFEBLD_constLOGICAL1:
  546.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  547.               FFEINFO_kindtypeLOGICAL1);
  548.       ffebld_constantunion_dump (ffebld_constant_union (c),
  549.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1);
  550.       break;
  551. #endif
  552.  
  553. #if FFETARGET_okLOGICAL2
  554.     case FFEBLD_constLOGICAL2:
  555.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  556.               FFEINFO_kindtypeLOGICAL2);
  557.       ffebld_constantunion_dump (ffebld_constant_union (c),
  558.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2);
  559.       break;
  560. #endif
  561.  
  562. #if FFETARGET_okLOGICAL3
  563.     case FFEBLD_constLOGICAL3:
  564.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  565.               FFEINFO_kindtypeLOGICAL3);
  566.       ffebld_constantunion_dump (ffebld_constant_union (c),
  567.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3);
  568.       break;
  569. #endif
  570.  
  571. #if FFETARGET_okLOGICAL4
  572.     case FFEBLD_constLOGICAL4:
  573.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  574.               FFEINFO_kindtypeLOGICAL4);
  575.       ffebld_constantunion_dump (ffebld_constant_union (c),
  576.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4);
  577.       break;
  578. #endif
  579.  
  580. #if FFETARGET_okLOGICAL5
  581.     case FFEBLD_constLOGICAL5:
  582.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  583.               FFEINFO_kindtypeLOGICAL5);
  584.       ffebld_constantunion_dump (ffebld_constant_union (c),
  585.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL5);
  586.       break;
  587. #endif
  588.  
  589. #if FFETARGET_okLOGICAL6
  590.     case FFEBLD_constLOGICAL6:
  591.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  592.               FFEINFO_kindtypeLOGICAL6);
  593.       ffebld_constantunion_dump (ffebld_constant_union (c),
  594.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL6);
  595.       break;
  596. #endif
  597.  
  598. #if FFETARGET_okLOGICAL7
  599.     case FFEBLD_constLOGICAL7:
  600.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  601.               FFEINFO_kindtypeLOGICAL7);
  602.       ffebld_constantunion_dump (ffebld_constant_union (c),
  603.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL7);
  604.       break;
  605. #endif
  606.  
  607. #if FFETARGET_okLOGICAL8
  608.     case FFEBLD_constLOGICAL8:
  609.       ffebld_dump_prefix (stdout, FFEINFO_basictypeLOGICAL,
  610.               FFEINFO_kindtypeLOGICAL8);
  611.       ffebld_constantunion_dump (ffebld_constant_union (c),
  612.             FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL8);
  613.       break;
  614. #endif
  615.  
  616. #if FFETARGET_okREAL1
  617.     case FFEBLD_constREAL1:
  618.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  619.               FFEINFO_kindtypeREAL1);
  620.       ffebld_constantunion_dump (ffebld_constant_union (c),
  621.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1);
  622.       break;
  623. #endif
  624.  
  625. #if FFETARGET_okREAL2
  626.     case FFEBLD_constREAL2:
  627.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  628.               FFEINFO_kindtypeREAL2);
  629.       ffebld_constantunion_dump (ffebld_constant_union (c),
  630.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL2);
  631.       break;
  632. #endif
  633.  
  634. #if FFETARGET_okREAL3
  635.     case FFEBLD_constREAL3:
  636.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  637.               FFEINFO_kindtypeREAL3);
  638.       ffebld_constantunion_dump (ffebld_constant_union (c),
  639.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL3);
  640.       break;
  641. #endif
  642.  
  643. #if FFETARGET_okREAL4
  644.     case FFEBLD_constREAL4:
  645.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  646.               FFEINFO_kindtypeREAL4);
  647.       ffebld_constantunion_dump (ffebld_constant_union (c),
  648.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL4);
  649.       break;
  650. #endif
  651.  
  652. #if FFETARGET_okREAL5
  653.     case FFEBLD_constREAL5:
  654.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  655.               FFEINFO_kindtypeREAL5);
  656.       ffebld_constantunion_dump (ffebld_constant_union (c),
  657.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL5);
  658.       break;
  659. #endif
  660.  
  661. #if FFETARGET_okREAL6
  662.     case FFEBLD_constREAL6:
  663.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  664.               FFEINFO_kindtypeREAL6);
  665.       ffebld_constantunion_dump (ffebld_constant_union (c),
  666.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL6);
  667.       break;
  668. #endif
  669.  
  670. #if FFETARGET_okREAL7
  671.     case FFEBLD_constREAL7:
  672.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  673.               FFEINFO_kindtypeREAL7);
  674.       ffebld_constantunion_dump (ffebld_constant_union (c),
  675.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL7);
  676.       break;
  677. #endif
  678.  
  679. #if FFETARGET_okREAL8
  680.     case FFEBLD_constREAL8:
  681.       ffebld_dump_prefix (stdout, FFEINFO_basictypeREAL,
  682.               FFEINFO_kindtypeREAL8);
  683.       ffebld_constantunion_dump (ffebld_constant_union (c),
  684.                   FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL8);
  685.       break;
  686. #endif
  687.  
  688. #if FFETARGET_okCOMPLEX1
  689.     case FFEBLD_constCOMPLEX1:
  690.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  691.               FFEINFO_kindtypeREAL1);
  692.       ffebld_constantunion_dump (ffebld_constant_union (c),
  693.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1);
  694.       break;
  695. #endif
  696.  
  697. #if FFETARGET_okCOMPLEX2
  698.     case FFEBLD_constCOMPLEX2:
  699.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  700.               FFEINFO_kindtypeREAL2);
  701.       ffebld_constantunion_dump (ffebld_constant_union (c),
  702.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL2);
  703.       break;
  704. #endif
  705.  
  706. #if FFETARGET_okCOMPLEX3
  707.     case FFEBLD_constCOMPLEX3:
  708.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  709.               FFEINFO_kindtypeREAL3);
  710.       ffebld_constantunion_dump (ffebld_constant_union (c),
  711.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL3);
  712.       break;
  713. #endif
  714.  
  715. #if FFETARGET_okCOMPLEX4
  716.     case FFEBLD_constCOMPLEX4:
  717.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  718.               FFEINFO_kindtypeREAL4);
  719.       ffebld_constantunion_dump (ffebld_constant_union (c),
  720.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL4);
  721.       break;
  722. #endif
  723.  
  724. #if FFETARGET_okCOMPLEX5
  725.     case FFEBLD_constCOMPLEX5:
  726.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  727.               FFEINFO_kindtypeREAL5);
  728.       ffebld_constantunion_dump (ffebld_constant_union (c),
  729.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL5);
  730.       break;
  731. #endif
  732.  
  733. #if FFETARGET_okCOMPLEX6
  734.     case FFEBLD_constCOMPLEX6:
  735.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  736.               FFEINFO_kindtypeREAL6);
  737.       ffebld_constantunion_dump (ffebld_constant_union (c),
  738.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL6);
  739.       break;
  740. #endif
  741.  
  742. #if FFETARGET_okCOMPLEX7
  743.     case FFEBLD_constCOMPLEX7:
  744.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  745.               FFEINFO_kindtypeREAL7);
  746.       ffebld_constantunion_dump (ffebld_constant_union (c),
  747.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL7);
  748.       break;
  749. #endif
  750.  
  751. #if FFETARGET_okCOMPLEX8
  752.     case FFEBLD_constCOMPLEX8:
  753.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCOMPLEX,
  754.               FFEINFO_kindtypeREAL8);
  755.       ffebld_constantunion_dump (ffebld_constant_union (c),
  756.                FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL8);
  757.       break;
  758. #endif
  759.  
  760. #if FFETARGET_okCHARACTER1
  761.     case FFEBLD_constCHARACTER1:
  762.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  763.               FFEINFO_kindtypeCHARACTER1);
  764.       ffebld_constantunion_dump (ffebld_constant_union (c),
  765.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER1);
  766.       break;
  767. #endif
  768.  
  769. #if FFETARGET_okCHARACTER2
  770.     case FFEBLD_constCHARACTER2:
  771.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  772.               FFEINFO_kindtypeCHARACTER2);
  773.       ffebld_constantunion_dump (ffebld_constant_union (c),
  774.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER2);
  775.       break;
  776. #endif
  777.  
  778. #if FFETARGET_okCHARACTER3
  779.     case FFEBLD_constCHARACTER3:
  780.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  781.               FFEINFO_kindtypeCHARACTER3);
  782.       ffebld_constantunion_dump (ffebld_constant_union (c),
  783.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER3);
  784.       break;
  785. #endif
  786.  
  787. #if FFETARGET_okCHARACTER4
  788.     case FFEBLD_constCHARACTER4:
  789.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  790.               FFEINFO_kindtypeCHARACTER4);
  791.       ffebld_constantunion_dump (ffebld_constant_union (c),
  792.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER4);
  793.       break;
  794. #endif
  795.  
  796. #if FFETARGET_okCHARACTER5
  797.     case FFEBLD_constCHARACTER5:
  798.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  799.               FFEINFO_kindtypeCHARACTER5);
  800.       ffebld_constantunion_dump (ffebld_constant_union (c),
  801.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER5);
  802.       break;
  803. #endif
  804.  
  805. #if FFETARGET_okCHARACTER6
  806.     case FFEBLD_constCHARACTER6:
  807.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  808.               FFEINFO_kindtypeCHARACTER6);
  809.       ffebld_constantunion_dump (ffebld_constant_union (c),
  810.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER6);
  811.       break;
  812. #endif
  813.  
  814. #if FFETARGET_okCHARACTER7
  815.     case FFEBLD_constCHARACTER7:
  816.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  817.               FFEINFO_kindtypeCHARACTER7);
  818.       ffebld_constantunion_dump (ffebld_constant_union (c),
  819.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER7);
  820.       break;
  821. #endif
  822.  
  823. #if FFETARGET_okCHARACTER8
  824.     case FFEBLD_constCHARACTER8:
  825.       ffebld_dump_prefix (stdout, FFEINFO_basictypeCHARACTER,
  826.               FFEINFO_kindtypeCHARACTER8);
  827.       ffebld_constantunion_dump (ffebld_constant_union (c),
  828.             FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER8);
  829.       break;
  830. #endif
  831.  
  832.     case FFEBLD_constHOLLERITH:
  833.       fprintf (stdout, "H%" ffetargetHollerithSize_f "u/",
  834.            ffebld_constant_hollerith (c).length);
  835.       ffetarget_print_hollerith (stdout, ffebld_constant_hollerith (c));
  836.       break;
  837.  
  838.     case FFEBLD_constBINARY_MIL:
  839.       fprintf (stdout, "BM/");
  840.       ffetarget_print_binarymil (stdout, ffebld_constant_typeless (c));
  841.       break;
  842.  
  843.     case FFEBLD_constBINARY_VXT:
  844.       fprintf (stdout, "BV/");
  845.       ffetarget_print_binaryvxt (stdout, ffebld_constant_typeless (c));
  846.       break;
  847.  
  848.     case FFEBLD_constOCTAL_MIL:
  849.       fprintf (stdout, "OM/");
  850.       ffetarget_print_octalmil (stdout, ffebld_constant_typeless (c));
  851.       break;
  852.  
  853.     case FFEBLD_constOCTAL_VXT:
  854.       fprintf (stdout, "OV/");
  855.       ffetarget_print_octalvxt (stdout, ffebld_constant_typeless (c));
  856.       break;
  857.  
  858.     case FFEBLD_constHEX_X_MIL:
  859.       fprintf (stdout, "XM/");
  860.       ffetarget_print_hexxmil (stdout, ffebld_constant_typeless (c));
  861.       break;
  862.  
  863.     case FFEBLD_constHEX_X_VXT:
  864.       fprintf (stdout, "XV/");
  865.       ffetarget_print_hexxvxt (stdout, ffebld_constant_typeless (c));
  866.       break;
  867.  
  868.     case FFEBLD_constHEX_Z_MIL:
  869.       fprintf (stdout, "ZM/");
  870.       ffetarget_print_hexzmil (stdout, ffebld_constant_typeless (c));
  871.       break;
  872.  
  873.     case FFEBLD_constHEX_Z_VXT:
  874.       fprintf (stdout, "ZV/");
  875.       ffetarget_print_hexzvxt (stdout, ffebld_constant_typeless (c));
  876.       break;
  877.  
  878.     default:
  879.       assert ("bad constant type" == NULL);
  880.       fprintf (stdout, "?/?");
  881.       break;
  882.     }
  883. }
  884.  
  885. /* ffebld_constant_is_magical -- Determine if integer is "magical"
  886.  
  887.    ffebldConstant c;
  888.    if (ffebld_constant_is_magical(c))
  889.        // it is 2**(n-1), where n is # bits in ffetargetIntegerDefault type
  890.        // (this test is important for 2's-complement machines only).  */
  891.  
  892. bool
  893. ffebld_constant_is_magical (ffebldConstant c)
  894. {
  895.   switch (ffebld_constant_type (c))
  896.     {
  897.     case FFEBLD_constINTEGERDEFAULT:
  898.       return ffetarget_integerdefault_is_magical (ffebld_constant_integer1 (c));
  899.  
  900.     default:
  901.       return FALSE;
  902.     }
  903. }
  904.  
  905. /* Determine if constant is zero.  Used only to ensure that step count
  906.    for DO loops isn't zero, so doesn't get called for COMPLEX.  */
  907.  
  908. bool
  909. ffebld_constant_is_zero (ffebldConstant c)
  910. {
  911.   switch (ffebld_constant_type (c))
  912.     {
  913. #if FFETARGET_okINTEGER1
  914.     case FFEBLD_constINTEGER1:
  915.       return ffebld_constant_integer1 (c) == 0;
  916. #endif
  917.  
  918. #if FFETARGET_okINTEGER2
  919.     case FFEBLD_constINTEGER2:
  920.       return ffebld_constant_integer2 (c) == 0;
  921. #endif
  922.  
  923. #if FFETARGET_okINTEGER3
  924.     case FFEBLD_constINTEGER3:
  925.       return ffebld_constant_integer3 (c) == 0;
  926. #endif
  927.  
  928. #if FFETARGET_okINTEGER4
  929.     case FFEBLD_constINTEGER4:
  930.       return ffebld_constant_integer4 (c) == 0;
  931. #endif
  932.  
  933. #if FFETARGET_okINTEGER5
  934.     case FFEBLD_constINTEGER5:
  935.       return ffebld_constant_integer5 (c) == 0;
  936. #endif
  937.  
  938. #if FFETARGET_okINTEGER6
  939.     case FFEBLD_constINTEGER6:
  940.       return ffebld_constant_integer6 (c) == 0;
  941. #endif
  942.  
  943. #if FFETARGET_okINTEGER7
  944.     case FFEBLD_constINTEGER7:
  945.       return ffebld_constant_integer7 (c) == 0;
  946. #endif
  947.  
  948. #if FFETARGET_okINTEGER8
  949.     case FFEBLD_constINTEGER8:
  950.       return ffebld_constant_integer8 (c) == 0;
  951. #endif
  952.  
  953. #if FFETARGET_okLOGICAL1
  954.     case FFEBLD_constLOGICAL1:
  955.       return ffebld_constant_logical1 (c) == 0;
  956. #endif
  957.  
  958. #if FFETARGET_okLOGICAL2
  959.     case FFEBLD_constLOGICAL2:
  960.       return ffebld_constant_logical2 (c) == 0;
  961. #endif
  962.  
  963. #if FFETARGET_okLOGICAL3
  964.     case FFEBLD_constLOGICAL3:
  965.       return ffebld_constant_logical3 (c) == 0;
  966. #endif
  967.  
  968. #if FFETARGET_okLOGICAL4
  969.     case FFEBLD_constLOGICAL4:
  970.       return ffebld_constant_logical4 (c) == 0;
  971. #endif
  972.  
  973. #if FFETARGET_okLOGICAL5
  974.     case FFEBLD_constLOGICAL5:
  975.       return ffebld_constant_logical5 (c) == 0;
  976. #endif
  977.  
  978. #if FFETARGET_okLOGICAL6
  979.     case FFEBLD_constLOGICAL6:
  980.       return ffebld_constant_logical6 (c) == 0;
  981. #endif
  982.  
  983. #if FFETARGET_okLOGICAL7
  984.     case FFEBLD_constLOGICAL7:
  985.       return ffebld_constant_logical7 (c) == 0;
  986. #endif
  987.  
  988. #if FFETARGET_okLOGICAL8
  989.     case FFEBLD_constLOGICAL8:
  990.       return ffebld_constant_logical8 (c) == 0;
  991. #endif
  992.  
  993. #if FFETARGET_okREAL1
  994.     case FFEBLD_constREAL1:
  995.       return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
  996. #endif
  997.  
  998. #if FFETARGET_okREAL2
  999.     case FFEBLD_constREAL2:
  1000.       return ffetarget_iszero_real2 (ffebld_constant_real2 (c));
  1001. #endif
  1002.  
  1003. #if FFETARGET_okREAL3
  1004.     case FFEBLD_constREAL3:
  1005.       return ffetarget_iszero_real3 (ffebld_constant_real3 (c));
  1006. #endif
  1007.  
  1008. #if FFETARGET_okREAL4
  1009.     case FFEBLD_constREAL4:
  1010.       return ffetarget_iszero_real4 (ffebld_constant_real4 (c));
  1011. #endif
  1012.  
  1013. #if FFETARGET_okREAL5
  1014.     case FFEBLD_constREAL5:
  1015.       return ffetarget_iszero_real5 (ffebld_constant_real5 (c));
  1016. #endif
  1017.  
  1018. #if FFETARGET_okREAL6
  1019.     case FFEBLD_constREAL6:
  1020.       return ffetarget_iszero_real6 (ffebld_constant_real6 (c));
  1021. #endif
  1022.  
  1023. #if FFETARGET_okREAL7
  1024.     case FFEBLD_constREAL7:
  1025.       return ffetarget_iszero_real7 (ffebld_constant_real7 (c));
  1026. #endif
  1027.  
  1028. #if FFETARGET_okREAL8
  1029.     case FFEBLD_constREAL8:
  1030.       return ffetarget_iszero_real8 (ffebld_constant_real8 (c));
  1031. #endif
  1032.  
  1033.     default:
  1034.       assert ("bad constant type" == NULL);
  1035.       return TRUE;
  1036.     }
  1037. }
  1038.  
  1039. /* ffebld_constant_new_character1 -- Return character1 constant object from token
  1040.  
  1041.    See prototype.  */
  1042.  
  1043. #if FFETARGET_okCHARACTER1
  1044. ffebldConstant
  1045. ffebld_constant_new_character1 (ffelexToken t)
  1046. {
  1047.   ffetargetCharacter1 val;
  1048.  
  1049.   ffetarget_character1 (&val, t, FFEBLD_CONSTANT_POOL_);
  1050.   return ffebld_constant_new_character1_val (val);
  1051. }
  1052.  
  1053. #endif
  1054. /* ffebld_constant_new_character1_val -- Return an character1 constant object
  1055.  
  1056.    See prototype.  */
  1057.  
  1058. #if FFETARGET_okCHARACTER1
  1059. ffebldConstant
  1060. ffebld_constant_new_character1_val (ffetargetCharacter1 val)
  1061. {
  1062.   ffebldConstant c;
  1063.   ffebldConstant nc;
  1064.   int cmp;
  1065.  
  1066.   for (c = (ffebldConstant) &ffebld_constant_character1_;
  1067.        c->next != NULL;
  1068.        c = c->next)
  1069.     {
  1070.       cmp = ffetarget_cmp_character1 (val, ffebld_constant_character1 (c->next));
  1071.       if (cmp == 0)
  1072.     return c->next;
  1073.       if (cmp > 0)
  1074.     break;
  1075.     }
  1076.  
  1077.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constCHARACTER1",
  1078.               sizeof (*nc));
  1079.   nc->next = c->next;
  1080.   nc->consttype = FFEBLD_constCHARACTER1;
  1081.   nc->u.character1 = val;
  1082. #ifdef FFECOM_constantHOOK
  1083.   nc->hook = FFECOM_constantNULL;
  1084. #endif
  1085.   c->next = nc;
  1086.  
  1087.   return nc;
  1088. }
  1089.  
  1090. #endif
  1091. /* ffebld_constant_new_complex1 -- Return complex1 constant object from token
  1092.  
  1093.    See prototype.  */
  1094.  
  1095. #if FFETARGET_okCOMPLEX1
  1096. ffebldConstant
  1097. ffebld_constant_new_complex1 (ffebldConstant real,
  1098.                   ffebldConstant imaginary)
  1099. {
  1100.   ffetargetComplex1 val;
  1101.  
  1102.   val.real = ffebld_constant_real1 (real);
  1103.   val.imaginary = ffebld_constant_real1 (imaginary);
  1104.   return ffebld_constant_new_complex1_val (val);
  1105. }
  1106.  
  1107. #endif
  1108. /* ffebld_constant_new_complex1_val -- Return a complex1 constant object
  1109.  
  1110.    See prototype.  */
  1111.  
  1112. #if FFETARGET_okCOMPLEX1
  1113. ffebldConstant
  1114. ffebld_constant_new_complex1_val (ffetargetComplex1 val)
  1115. {
  1116.   ffebldConstant c;
  1117.   ffebldConstant nc;
  1118.   int cmp;
  1119.  
  1120.   for (c = (ffebldConstant) &ffebld_constant_complex1_;
  1121.        c->next != NULL;
  1122.        c = c->next)
  1123.     {
  1124.       cmp = ffetarget_cmp_real1 (val.real, ffebld_constant_complex1 (c->next).real);
  1125.       if (cmp == 0)
  1126.     cmp = ffetarget_cmp_real1 (val.imaginary,
  1127.                   ffebld_constant_complex1 (c->next).imaginary);
  1128.       if (cmp == 0)
  1129.     return c->next;
  1130.       if (cmp > 0)
  1131.     break;
  1132.     }
  1133.  
  1134.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constCOMPLEX1", sizeof (*nc));
  1135.   nc->next = c->next;
  1136.   nc->consttype = FFEBLD_constCOMPLEX1;
  1137.   nc->u.complex1 = val;
  1138. #ifdef FFECOM_constantHOOK
  1139.   nc->hook = FFECOM_constantNULL;
  1140. #endif
  1141.   c->next = nc;
  1142.  
  1143.   return nc;
  1144. }
  1145.  
  1146. #endif
  1147. /* ffebld_constant_new_complex2 -- Return complex2 constant object from token
  1148.  
  1149.    See prototype.  */
  1150.  
  1151. #if FFETARGET_okCOMPLEX2
  1152. ffebldConstant
  1153. ffebld_constant_new_complex2 (ffebldConstant real,
  1154.                   ffebldConstant imaginary)
  1155. {
  1156.   ffetargetComplex2 val;
  1157.  
  1158.   val.real = ffebld_constant_real2 (real);
  1159.   val.imaginary = ffebld_constant_real2 (imaginary);
  1160.   return ffebld_constant_new_complex2_val (val);
  1161. }
  1162.  
  1163. #endif
  1164. /* ffebld_constant_new_complex2_val -- Return a complex2 constant object
  1165.  
  1166.    See prototype.  */
  1167.  
  1168. #if FFETARGET_okCOMPLEX2
  1169. ffebldConstant
  1170. ffebld_constant_new_complex2_val (ffetargetComplex2 val)
  1171. {
  1172.   ffebldConstant c;
  1173.   ffebldConstant nc;
  1174.   int cmp;
  1175.  
  1176.   for (c = (ffebldConstant) &ffebld_constant_complex2_;
  1177.        c->next != NULL;
  1178.        c = c->next)
  1179.     {
  1180.       cmp = ffetarget_cmp_real2 (val.real, ffebld_constant_complex2 (c->next).real);
  1181.       if (cmp == 0)
  1182.     cmp = ffetarget_cmp_real2 (val.imaginary,
  1183.                   ffebld_constant_complex2 (c->next).imaginary);
  1184.       if (cmp == 0)
  1185.     return c->next;
  1186.       if (cmp > 0)
  1187.     break;
  1188.     }
  1189.  
  1190.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constCOMPLEX2", sizeof (*nc));
  1191.   nc->next = c->next;
  1192.   nc->consttype = FFEBLD_constCOMPLEX2;
  1193.   nc->u.complex2 = val;
  1194. #ifdef FFECOM_constantHOOK
  1195.   nc->hook = FFECOM_constantNULL;
  1196. #endif
  1197.   c->next = nc;
  1198.  
  1199.   return nc;
  1200. }
  1201.  
  1202. #endif
  1203. /* ffebld_constant_new_hollerith -- Return hollerith constant object from token
  1204.  
  1205.    See prototype.  */
  1206.  
  1207. ffebldConstant
  1208. ffebld_constant_new_hollerith (ffelexToken t)
  1209. {
  1210.   ffetargetHollerith val;
  1211.  
  1212.   ffetarget_hollerith (&val, t, FFEBLD_CONSTANT_POOL_);
  1213.   return ffebld_constant_new_hollerith_val (val);
  1214. }
  1215.  
  1216. /* ffebld_constant_new_hollerith_val -- Return an hollerith constant object
  1217.  
  1218.    See prototype.  */
  1219.  
  1220. ffebldConstant
  1221. ffebld_constant_new_hollerith_val (ffetargetHollerith val)
  1222. {
  1223.   ffebldConstant c;
  1224.   ffebldConstant nc;
  1225.   int cmp;
  1226.  
  1227.   for (c = (ffebldConstant) &ffebld_constant_hollerith_;
  1228.        c->next != NULL;
  1229.        c = c->next)
  1230.     {
  1231.       cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (c->next));
  1232.       if (cmp == 0)
  1233.     return c->next;
  1234.       if (cmp > 0)
  1235.     break;
  1236.     }
  1237.  
  1238.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constHOLLERITH",
  1239.               sizeof (*nc));
  1240.   nc->next = c->next;
  1241.   nc->consttype = FFEBLD_constHOLLERITH;
  1242.   nc->u.hollerith = val;
  1243. #ifdef FFECOM_constantHOOK
  1244.   nc->hook = FFECOM_constantNULL;
  1245. #endif
  1246.   c->next = nc;
  1247.  
  1248.   return nc;
  1249. }
  1250.  
  1251. /* ffebld_constant_new_integer1 -- Return integer1 constant object from token
  1252.  
  1253.    See prototype.
  1254.  
  1255.    Parses the token as a decimal integer constant, thus it must be an
  1256.    FFELEX_typeNUMBER.  */
  1257.  
  1258. #if FFETARGET_okINTEGER1
  1259. ffebldConstant
  1260. ffebld_constant_new_integer1 (ffelexToken t)
  1261. {
  1262.   ffetargetInteger1 val;
  1263.  
  1264.   assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
  1265.  
  1266.   ffetarget_integer1 (&val, t);
  1267.   return ffebld_constant_new_integer1_val (val);
  1268. }
  1269.  
  1270. #endif
  1271. /* ffebld_constant_new_integer1_val -- Return an integer1 constant object
  1272.  
  1273.    See prototype.  */
  1274.  
  1275. #if FFETARGET_okINTEGER1
  1276. ffebldConstant
  1277. ffebld_constant_new_integer1_val (ffetargetInteger1 val)
  1278. {
  1279.   ffebldConstant c;
  1280.   ffebldConstant nc;
  1281.   int cmp;
  1282.  
  1283.   for (c = (ffebldConstant) &ffebld_constant_integer1_;
  1284.        c->next != NULL;
  1285.        c = c->next)
  1286.     {
  1287.       cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (c->next));
  1288.       if (cmp == 0)
  1289.     return c->next;
  1290.       if (cmp > 0)
  1291.     break;
  1292.     }
  1293.  
  1294.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constINTEGER1", sizeof (*nc));
  1295.   nc->next = c->next;
  1296.   nc->consttype = FFEBLD_constINTEGER1;
  1297.   nc->u.integer1 = val;
  1298. #ifdef FFECOM_constantHOOK
  1299.   nc->hook = FFECOM_constantNULL;
  1300. #endif
  1301.   c->next = nc;
  1302.  
  1303.   return nc;
  1304. }
  1305.  
  1306. #endif
  1307. /* ffebld_constant_new_integer2_val -- Return an integer2 constant object
  1308.  
  1309.    See prototype.  */
  1310.  
  1311. #if FFETARGET_okINTEGER2
  1312. ffebldConstant
  1313. ffebld_constant_new_integer2_val (ffetargetInteger2 val)
  1314. {
  1315.   ffebldConstant c;
  1316.   ffebldConstant nc;
  1317.   int cmp;
  1318.  
  1319.   for (c = (ffebldConstant) &ffebld_constant_integer2_;
  1320.        c->next != NULL;
  1321.        c = c->next)
  1322.     {
  1323.       cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (c->next));
  1324.       if (cmp == 0)
  1325.     return c->next;
  1326.       if (cmp > 0)
  1327.     break;
  1328.     }
  1329.  
  1330.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constINTEGER2", sizeof (*nc));
  1331.   nc->next = c->next;
  1332.   nc->consttype = FFEBLD_constINTEGER2;
  1333.   nc->u.integer2 = val;
  1334. #ifdef FFECOM_constantHOOK
  1335.   nc->hook = FFECOM_constantNULL;
  1336. #endif
  1337.   c->next = nc;
  1338.  
  1339.   return nc;
  1340. }
  1341.  
  1342. #endif
  1343. /* ffebld_constant_new_integer3_val -- Return an integer3 constant object
  1344.  
  1345.    See prototype.  */
  1346.  
  1347. #if FFETARGET_okINTEGER3
  1348. ffebldConstant
  1349. ffebld_constant_new_integer3_val (ffetargetInteger3 val)
  1350. {
  1351.   ffebldConstant c;
  1352.   ffebldConstant nc;
  1353.   int cmp;
  1354.  
  1355.   for (c = (ffebldConstant) &ffebld_constant_integer3_;
  1356.        c->next != NULL;
  1357.        c = c->next)
  1358.     {
  1359.       cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (c->next));
  1360.       if (cmp == 0)
  1361.     return c->next;
  1362.       if (cmp > 0)
  1363.     break;
  1364.     }
  1365.  
  1366.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constINTEGER3", sizeof (*nc));
  1367.   nc->next = c->next;
  1368.   nc->consttype = FFEBLD_constINTEGER3;
  1369.   nc->u.integer3 = val;
  1370. #ifdef FFECOM_constantHOOK
  1371.   nc->hook = FFECOM_constantNULL;
  1372. #endif
  1373.   c->next = nc;
  1374.  
  1375.   return nc;
  1376. }
  1377.  
  1378. #endif
  1379. /* ffebld_constant_new_integeroctal -- Return octal constant object from token
  1380.  
  1381.    See prototype.
  1382.  
  1383.    Parses the token as a decimal integer constant, thus it must be an
  1384.    FFELEX_typeNUMBER.  */
  1385.  
  1386. ffebldConstant
  1387. ffebld_constant_new_integeroctal (ffelexToken t)
  1388. {
  1389.   ffetargetIntegerDefault val;
  1390.  
  1391.   assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
  1392.  
  1393.   ffetarget_integeroctal (&val, t);
  1394.   return ffebld_constant_new_integerdefault_val (val);
  1395. }
  1396.  
  1397. /* ffebld_constant_new_logical1 -- Return logical1 constant object from token
  1398.  
  1399.    See prototype.
  1400.  
  1401.    Parses the token as a decimal logical constant, thus it must be an
  1402.    FFELEX_typeNUMBER.  */
  1403.  
  1404. #if FFETARGET_okLOGICAL1
  1405. ffebldConstant
  1406. ffebld_constant_new_logical1 (bool truth)
  1407. {
  1408.   ffetargetLogical1 val;
  1409.  
  1410.   ffetarget_logical1 (&val, truth);
  1411.   return ffebld_constant_new_logical1_val (val);
  1412. }
  1413.  
  1414. #endif
  1415. /* ffebld_constant_new_logical1_val -- Return a logical1 constant object
  1416.  
  1417.    See prototype.  */
  1418.  
  1419. #if FFETARGET_okLOGICAL1
  1420. ffebldConstant
  1421. ffebld_constant_new_logical1_val (ffetargetLogical1 val)
  1422. {
  1423.   ffebldConstant c;
  1424.   ffebldConstant nc;
  1425.   int cmp;
  1426.  
  1427.   for (c = (ffebldConstant) &ffebld_constant_logical1_;
  1428.        c->next != NULL;
  1429.        c = c->next)
  1430.     {
  1431.       cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (c->next));
  1432.       if (cmp == 0)
  1433.     return c->next;
  1434.       if (cmp > 0)
  1435.     break;
  1436.     }
  1437.  
  1438.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constLOGICAL1", sizeof (*nc));
  1439.   nc->next = c->next;
  1440.   nc->consttype = FFEBLD_constLOGICAL1;
  1441.   nc->u.logical1 = val;
  1442. #ifdef FFECOM_constantHOOK
  1443.   nc->hook = FFECOM_constantNULL;
  1444. #endif
  1445.   c->next = nc;
  1446.  
  1447.   return nc;
  1448. }
  1449.  
  1450. #endif
  1451. /* ffebld_constant_new_logical2_val -- Return a logical2 constant object
  1452.  
  1453.    See prototype.  */
  1454.  
  1455. #if FFETARGET_okLOGICAL2
  1456. ffebldConstant
  1457. ffebld_constant_new_logical2_val (ffetargetLogical2 val)
  1458. {
  1459.   ffebldConstant c;
  1460.   ffebldConstant nc;
  1461.   int cmp;
  1462.  
  1463.   for (c = (ffebldConstant) &ffebld_constant_logical2_;
  1464.        c->next != NULL;
  1465.        c = c->next)
  1466.     {
  1467.       cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (c->next));
  1468.       if (cmp == 0)
  1469.     return c->next;
  1470.       if (cmp > 0)
  1471.     break;
  1472.     }
  1473.  
  1474.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constLOGICAL2", sizeof (*nc));
  1475.   nc->next = c->next;
  1476.   nc->consttype = FFEBLD_constLOGICAL2;
  1477.   nc->u.logical2 = val;
  1478. #ifdef FFECOM_constantHOOK
  1479.   nc->hook = FFECOM_constantNULL;
  1480. #endif
  1481.   c->next = nc;
  1482.  
  1483.   return nc;
  1484. }
  1485.  
  1486. #endif
  1487. /* ffebld_constant_new_logical3_val -- Return a logical3 constant object
  1488.  
  1489.    See prototype.  */
  1490.  
  1491. #if FFETARGET_okLOGICAL3
  1492. ffebldConstant
  1493. ffebld_constant_new_logical3_val (ffetargetLogical3 val)
  1494. {
  1495.   ffebldConstant c;
  1496.   ffebldConstant nc;
  1497.   int cmp;
  1498.  
  1499.   for (c = (ffebldConstant) &ffebld_constant_logical3_;
  1500.        c->next != NULL;
  1501.        c = c->next)
  1502.     {
  1503.       cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (c->next));
  1504.       if (cmp == 0)
  1505.     return c->next;
  1506.       if (cmp > 0)
  1507.     break;
  1508.     }
  1509.  
  1510.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constLOGICAL3", sizeof (*nc));
  1511.   nc->next = c->next;
  1512.   nc->consttype = FFEBLD_constLOGICAL3;
  1513.   nc->u.logical3 = val;
  1514. #ifdef FFECOM_constantHOOK
  1515.   nc->hook = FFECOM_constantNULL;
  1516. #endif
  1517.   c->next = nc;
  1518.  
  1519.   return nc;
  1520. }
  1521.  
  1522. #endif
  1523. /* ffebld_constant_new_real1 -- Return real1 constant object from token
  1524.  
  1525.    See prototype.  */
  1526.  
  1527. #if FFETARGET_okREAL1
  1528. ffebldConstant
  1529. ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal,
  1530.       ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
  1531.                ffelexToken exponent_digits)
  1532. {
  1533.   ffetargetReal1 val;
  1534.  
  1535.   ffetarget_real1 (&val,
  1536.       integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
  1537.   return ffebld_constant_new_real1_val (val);
  1538. }
  1539.  
  1540. #endif
  1541. /* ffebld_constant_new_real1_val -- Return an real1 constant object
  1542.  
  1543.    See prototype.  */
  1544.  
  1545. #if FFETARGET_okREAL1
  1546. ffebldConstant
  1547. ffebld_constant_new_real1_val (ffetargetReal1 val)
  1548. {
  1549.   ffebldConstant c;
  1550.   ffebldConstant nc;
  1551.   int cmp;
  1552.  
  1553.   for (c = (ffebldConstant) &ffebld_constant_real1_;
  1554.        c->next != NULL;
  1555.        c = c->next)
  1556.     {
  1557.       cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (c->next));
  1558.       if (cmp == 0)
  1559.     return c->next;
  1560.       if (cmp > 0)
  1561.     break;
  1562.     }
  1563.  
  1564.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constREAL1", sizeof (*nc));
  1565.   nc->next = c->next;
  1566.   nc->consttype = FFEBLD_constREAL1;
  1567.   nc->u.real1 = val;
  1568. #ifdef FFECOM_constantHOOK
  1569.   nc->hook = FFECOM_constantNULL;
  1570. #endif
  1571.   c->next = nc;
  1572.  
  1573.   return nc;
  1574. }
  1575.  
  1576. #endif
  1577. /* ffebld_constant_new_real2 -- Return real2 constant object from token
  1578.  
  1579.    See prototype.  */
  1580.  
  1581. #if FFETARGET_okREAL2
  1582. ffebldConstant
  1583. ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal,
  1584.       ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
  1585.                ffelexToken exponent_digits)
  1586. {
  1587.   ffetargetReal2 val;
  1588.  
  1589.   ffetarget_real2 (&val,
  1590.       integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
  1591.   return ffebld_constant_new_real2_val (val);
  1592. }
  1593.  
  1594. #endif
  1595. /* ffebld_constant_new_real2_val -- Return an real2 constant object
  1596.  
  1597.    See prototype.  */
  1598.  
  1599. #if FFETARGET_okREAL2
  1600. ffebldConstant
  1601. ffebld_constant_new_real2_val (ffetargetReal2 val)
  1602. {
  1603.   ffebldConstant c;
  1604.   ffebldConstant nc;
  1605.   int cmp;
  1606.  
  1607.   for (c = (ffebldConstant) &ffebld_constant_real2_;
  1608.        c->next != NULL;
  1609.        c = c->next)
  1610.     {
  1611.       cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (c->next));
  1612.       if (cmp == 0)
  1613.     return c->next;
  1614.       if (cmp > 0)
  1615.     break;
  1616.     }
  1617.  
  1618.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constREAL2", sizeof (*nc));
  1619.   nc->next = c->next;
  1620.   nc->consttype = FFEBLD_constREAL2;
  1621.   nc->u.real2 = val;
  1622. #ifdef FFECOM_constantHOOK
  1623.   nc->hook = FFECOM_constantNULL;
  1624. #endif
  1625.   c->next = nc;
  1626.  
  1627.   return nc;
  1628. }
  1629.  
  1630. #endif
  1631. /* ffebld_constant_new_typeless_bm -- Return typeless constant object from token
  1632.  
  1633.    See prototype.
  1634.  
  1635.    Parses the token as a decimal integer constant, thus it must be an
  1636.    FFELEX_typeNUMBER.  */
  1637.  
  1638. ffebldConstant
  1639. ffebld_constant_new_typeless_bm (ffelexToken t)
  1640. {
  1641.   ffetargetTypeless val;
  1642.  
  1643.   ffetarget_binarymil (&val, t);
  1644.   return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_MIL, val);
  1645. }
  1646.  
  1647. /* ffebld_constant_new_typeless_bv -- Return typeless constant object from token
  1648.  
  1649.    See prototype.
  1650.  
  1651.    Parses the token as a decimal integer constant, thus it must be an
  1652.    FFELEX_typeNUMBER.  */
  1653.  
  1654. ffebldConstant
  1655. ffebld_constant_new_typeless_bv (ffelexToken t)
  1656. {
  1657.   ffetargetTypeless val;
  1658.  
  1659.   ffetarget_binaryvxt (&val, t);
  1660.   return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_VXT, val);
  1661. }
  1662.  
  1663. /* ffebld_constant_new_typeless_hxm -- Return typeless constant object from token
  1664.  
  1665.    See prototype.
  1666.  
  1667.    Parses the token as a decimal integer constant, thus it must be an
  1668.    FFELEX_typeNUMBER.  */
  1669.  
  1670. ffebldConstant
  1671. ffebld_constant_new_typeless_hxm (ffelexToken t)
  1672. {
  1673.   ffetargetTypeless val;
  1674.  
  1675.   ffetarget_hexxmil (&val, t);
  1676.   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_MIL, val);
  1677. }
  1678.  
  1679. /* ffebld_constant_new_typeless_hxv -- Return typeless constant object from token
  1680.  
  1681.    See prototype.
  1682.  
  1683.    Parses the token as a decimal integer constant, thus it must be an
  1684.    FFELEX_typeNUMBER.  */
  1685.  
  1686. ffebldConstant
  1687. ffebld_constant_new_typeless_hxv (ffelexToken t)
  1688. {
  1689.   ffetargetTypeless val;
  1690.  
  1691.   ffetarget_hexxvxt (&val, t);
  1692.   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_VXT, val);
  1693. }
  1694.  
  1695. /* ffebld_constant_new_typeless_hzm -- Return typeless constant object from token
  1696.  
  1697.    See prototype.
  1698.  
  1699.    Parses the token as a decimal integer constant, thus it must be an
  1700.    FFELEX_typeNUMBER.  */
  1701.  
  1702. ffebldConstant
  1703. ffebld_constant_new_typeless_hzm (ffelexToken t)
  1704. {
  1705.   ffetargetTypeless val;
  1706.  
  1707.   ffetarget_hexzmil (&val, t);
  1708.   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_MIL, val);
  1709. }
  1710.  
  1711. /* ffebld_constant_new_typeless_hzv -- Return typeless constant object from token
  1712.  
  1713.    See prototype.
  1714.  
  1715.    Parses the token as a decimal integer constant, thus it must be an
  1716.    FFELEX_typeNUMBER.  */
  1717.  
  1718. ffebldConstant
  1719. ffebld_constant_new_typeless_hzv (ffelexToken t)
  1720. {
  1721.   ffetargetTypeless val;
  1722.  
  1723.   ffetarget_hexzvxt (&val, t);
  1724.   return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_VXT, val);
  1725. }
  1726.  
  1727. /* ffebld_constant_new_typeless_om -- Return typeless constant object from token
  1728.  
  1729.    See prototype.
  1730.  
  1731.    Parses the token as a decimal integer constant, thus it must be an
  1732.    FFELEX_typeNUMBER.  */
  1733.  
  1734. ffebldConstant
  1735. ffebld_constant_new_typeless_om (ffelexToken t)
  1736. {
  1737.   ffetargetTypeless val;
  1738.  
  1739.   ffetarget_octalmil (&val, t);
  1740.   return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_MIL, val);
  1741. }
  1742.  
  1743. /* ffebld_constant_new_typeless_ov -- Return typeless constant object from token
  1744.  
  1745.    See prototype.
  1746.  
  1747.    Parses the token as a decimal integer constant, thus it must be an
  1748.    FFELEX_typeNUMBER.  */
  1749.  
  1750. ffebldConstant
  1751. ffebld_constant_new_typeless_ov (ffelexToken t)
  1752. {
  1753.   ffetargetTypeless val;
  1754.  
  1755.   ffetarget_octalvxt (&val, t);
  1756.   return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_VXT, val);
  1757. }
  1758.  
  1759. /* ffebld_constant_new_typeless_val -- Return a typeless constant object
  1760.  
  1761.    See prototype.  */
  1762.  
  1763. ffebldConstant
  1764. ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val)
  1765. {
  1766.   ffebldConstant c;
  1767.   ffebldConstant nc;
  1768.   int cmp;
  1769.  
  1770.   for (c = (ffebldConstant) &ffebld_constant_typeless_[type
  1771.                           - FFEBLD_constTYPELESS_FIRST];
  1772.        c->next != NULL;
  1773.        c = c->next)
  1774.     {
  1775.       cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (c->next));
  1776.       if (cmp == 0)
  1777.     return c->next;
  1778.       if (cmp > 0)
  1779.     break;
  1780.     }
  1781.  
  1782.   nc = malloc_new_kp (FFEBLD_CONSTANT_POOL_, "FFEBLD_constTYPELESS", sizeof (*nc));
  1783.   nc->next = c->next;
  1784.   nc->consttype = type;
  1785.   nc->u.typeless = val;
  1786. #ifdef FFECOM_constantHOOK
  1787.   nc->hook = FFECOM_constantNULL;
  1788. #endif
  1789.   c->next = nc;
  1790.  
  1791.   return nc;
  1792. }
  1793.  
  1794. /* ffebld_constantarray_dump -- Display summary of array's contents
  1795.  
  1796.    ffebldConstantArray a;
  1797.    ffeinfoBasictype bt;
  1798.    ffeinfoKindtype kt;
  1799.    ffetargetOffset size;
  1800.    ffebld_constant_dump(a,bt,kt,size,NULL);
  1801.  
  1802.    Displays the constant array in summary form.     The fifth argument, if
  1803.    supplied, is an ffebit object that is consulted as to whether the
  1804.    constant at a particular offset is valid.  */
  1805.  
  1806. void
  1807. ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
  1808.               ffeinfoKindtype kt, ffetargetOffset size, ffebit bits)
  1809. {
  1810.   ffetargetOffset i;
  1811.  
  1812.   ffebld_dump_prefix (stdout, bt, kt);
  1813.  
  1814.   fprintf (stdout, "\\(");
  1815.  
  1816.   if (bits == NULL)
  1817.     {
  1818.       for (i = 0; i < size; ++i)
  1819.     {
  1820.       ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt, i), bt,
  1821.                      kt);
  1822.       if (i != size - 1)
  1823.         fputc (',', stdout);
  1824.     }
  1825.     }
  1826.   else
  1827.     {
  1828.       bool value;
  1829.       ffebitCount length;
  1830.       ffetargetOffset offset = 0;
  1831.  
  1832.       do
  1833.     {
  1834.       ffebit_test (bits, offset, &value, &length);
  1835.       if (value && (length != 0))
  1836.         {
  1837.           if (length == 1)
  1838.         fprintf (stdout, "[%" ffetargetOffset_f "u]:", offset);
  1839.           else
  1840.         fprintf (stdout,
  1841.               "[%" ffetargetOffset_f "u..%" ffetargetOffset_f "u]:",
  1842.              offset, offset + length - 1);
  1843.           for (i = 0; i < length; ++i, ++offset)
  1844.         {
  1845.           ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt,
  1846.                                offset), bt, kt);
  1847.           if (i != length - 1)
  1848.             fputc (',', stdout);
  1849.         }
  1850.           fprintf (stdout, ";");
  1851.         }
  1852.       else
  1853.         offset += length;
  1854.     }
  1855.       while (length != 0);
  1856.     }
  1857.   fprintf (stdout, "\\)");
  1858.  
  1859. }
  1860.  
  1861. /* ffebld_constantarray_get -- Get a value from an array of constants
  1862.  
  1863.    See prototype.  */
  1864.  
  1865. ffebldConstantUnion
  1866. ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
  1867.               ffeinfoKindtype kt, ffetargetOffset offset)
  1868. {
  1869.   ffebldConstantUnion u;
  1870.  
  1871.   switch (bt)
  1872.     {
  1873.     case FFEINFO_basictypeINTEGER:
  1874.       switch (kt)
  1875.     {
  1876. #if FFETARGET_okINTEGER1
  1877.     case FFEINFO_kindtypeINTEGER1:
  1878.       u.integer1 = *(array.integer1 + offset);
  1879.       break;
  1880. #endif
  1881.  
  1882. #if FFETARGET_okINTEGER2
  1883.     case FFEINFO_kindtypeINTEGER2:
  1884.       u.integer2 = *(array.integer2 + offset);
  1885.       break;
  1886. #endif
  1887.  
  1888. #if FFETARGET_okINTEGER3
  1889.     case FFEINFO_kindtypeINTEGER3:
  1890.       u.integer3 = *(array.integer3 + offset);
  1891.       break;
  1892. #endif
  1893.  
  1894. #if FFETARGET_okINTEGER4
  1895.     case FFEINFO_kindtypeINTEGER4:
  1896.       u.integer4 = *(array.integer4 + offset);
  1897.       break;
  1898. #endif
  1899.  
  1900. #if FFETARGET_okINTEGER5
  1901.     case FFEINFO_kindtypeINTEGER5:
  1902.       u.integer5 = *(array.integer5 + offset);
  1903.       break;
  1904. #endif
  1905.  
  1906. #if FFETARGET_okINTEGER6
  1907.     case FFEINFO_kindtypeINTEGER6:
  1908.       u.integer6 = *(array.integer6 + offset);
  1909.       break;
  1910. #endif
  1911.  
  1912. #if FFETARGET_okINTEGER7
  1913.     case FFEINFO_kindtypeINTEGER7:
  1914.       u.integer7 = *(array.integer7 + offset);
  1915.       break;
  1916. #endif
  1917.  
  1918. #if FFETARGET_okINTEGER8
  1919.     case FFEINFO_kindtypeINTEGER8:
  1920.       u.integer8 = *(array.integer8 + offset);
  1921.       break;
  1922. #endif
  1923.  
  1924.     default:
  1925.       assert ("bad INTEGER kindtype" == NULL);
  1926.       break;
  1927.     }
  1928.       break;
  1929.  
  1930.     case FFEINFO_basictypeLOGICAL:
  1931.       switch (kt)
  1932.     {
  1933. #if FFETARGET_okLOGICAL1
  1934.     case FFEINFO_kindtypeLOGICAL1:
  1935.       u.logical1 = *(array.logical1 + offset);
  1936.       break;
  1937. #endif
  1938.  
  1939. #if FFETARGET_okLOGICAL2
  1940.     case FFEINFO_kindtypeLOGICAL2:
  1941.       u.logical2 = *(array.logical2 + offset);
  1942.       break;
  1943. #endif
  1944.  
  1945. #if FFETARGET_okLOGICAL3
  1946.     case FFEINFO_kindtypeLOGICAL3:
  1947.       u.logical3 = *(array.logical3 + offset);
  1948.       break;
  1949. #endif
  1950.  
  1951. #if FFETARGET_okLOGICAL4
  1952.     case FFEINFO_kindtypeLOGICAL4:
  1953.       u.logical4 = *(array.logical4 + offset);
  1954.       break;
  1955. #endif
  1956.  
  1957. #if FFETARGET_okLOGICAL5
  1958.     case FFEINFO_kindtypeLOGICAL5:
  1959.       u.logical5 = *(array.logical5 + offset);
  1960.       break;
  1961. #endif
  1962.  
  1963. #if FFETARGET_okLOGICAL6
  1964.     case FFEINFO_kindtypeLOGICAL6:
  1965.       u.logical6 = *(array.logical6 + offset);
  1966.       break;
  1967. #endif
  1968.  
  1969. #if FFETARGET_okLOGICAL7
  1970.     case FFEINFO_kindtypeLOGICAL7:
  1971.       u.logical7 = *(array.logical7 + offset);
  1972.       break;
  1973. #endif
  1974.  
  1975. #if FFETARGET_okLOGICAL8
  1976.     case FFEINFO_kindtypeLOGICAL8:
  1977.       u.logical8 = *(array.logical8 + offset);
  1978.       break;
  1979. #endif
  1980.  
  1981.     default:
  1982.       assert ("bad LOGICAL kindtype" == NULL);
  1983.       break;
  1984.     }
  1985.       break;
  1986.  
  1987.     case FFEINFO_basictypeREAL:
  1988.       switch (kt)
  1989.     {
  1990. #if FFETARGET_okREAL1
  1991.     case FFEINFO_kindtypeREAL1:
  1992.       u.real1 = *(array.real1 + offset);
  1993.       break;
  1994. #endif
  1995.  
  1996. #if FFETARGET_okREAL2
  1997.     case FFEINFO_kindtypeREAL2:
  1998.       u.real2 = *(array.real2 + offset);
  1999.       break;
  2000. #endif
  2001.  
  2002. #if FFETARGET_okREAL3
  2003.     case FFEINFO_kindtypeREAL3:
  2004.       u.real3 = *(array.real3 + offset);
  2005.       break;
  2006. #endif
  2007.  
  2008. #if FFETARGET_okREAL4
  2009.     case FFEINFO_kindtypeREAL4:
  2010.       u.real4 = *(array.real4 + offset);
  2011.       break;
  2012. #endif
  2013.  
  2014. #if FFETARGET_okREAL5
  2015.     case FFEINFO_kindtypeREAL5:
  2016.       u.real5 = *(array.real5 + offset);
  2017.       break;
  2018. #endif
  2019.  
  2020. #if FFETARGET_okREAL6
  2021.     case FFEINFO_kindtypeREAL6:
  2022.       u.real6 = *(array.real6 + offset);
  2023.       break;
  2024. #endif
  2025.  
  2026. #if FFETARGET_okREAL7
  2027.     case FFEINFO_kindtypeREAL7:
  2028.       u.real7 = *(array.real7 + offset);
  2029.       break;
  2030. #endif
  2031.  
  2032. #if FFETARGET_okREAL8
  2033.     case FFEINFO_kindtypeREAL8:
  2034.       u.real8 = *(array.real8 + offset);
  2035.       break;
  2036. #endif
  2037.  
  2038.     default:
  2039.       assert ("bad REAL kindtype" == NULL);
  2040.       break;
  2041.     }
  2042.       break;
  2043.  
  2044.     case FFEINFO_basictypeCOMPLEX:
  2045.       switch (kt)
  2046.     {
  2047. #if FFETARGET_okCOMPLEX1
  2048.     case FFEINFO_kindtypeREAL1:
  2049.       u.complex1 = *(array.complex1 + offset);
  2050.       break;
  2051. #endif
  2052.  
  2053. #if FFETARGET_okCOMPLEX2
  2054.     case FFEINFO_kindtypeREAL2:
  2055.       u.complex2 = *(array.complex2 + offset);
  2056.       break;
  2057. #endif
  2058.  
  2059. #if FFETARGET_okCOMPLEX3
  2060.     case FFEINFO_kindtypeREAL3:
  2061.       u.complex3 = *(array.complex3 + offset);
  2062.       break;
  2063. #endif
  2064.  
  2065. #if FFETARGET_okCOMPLEX4
  2066.     case FFEINFO_kindtypeREAL4:
  2067.       u.complex4 = *(array.complex4 + offset);
  2068.       break;
  2069. #endif
  2070.  
  2071. #if FFETARGET_okCOMPLEX5
  2072.     case FFEINFO_kindtypeREAL5:
  2073.       u.complex5 = *(array.complex5 + offset);
  2074.       break;
  2075. #endif
  2076.  
  2077. #if FFETARGET_okCOMPLEX6
  2078.     case FFEINFO_kindtypeREAL6:
  2079.       u.complex6 = *(array.complex6 + offset);
  2080.       break;
  2081. #endif
  2082.  
  2083. #if FFETARGET_okCOMPLEX7
  2084.     case FFEINFO_kindtypeREAL7:
  2085.       u.complex7 = *(array.complex7 + offset);
  2086.       break;
  2087. #endif
  2088.  
  2089. #if FFETARGET_okCOMPLEX8
  2090.     case FFEINFO_kindtypeREAL8:
  2091.       u.complex8 = *(array.complex8 + offset);
  2092.       break;
  2093. #endif
  2094.  
  2095.     default:
  2096.       assert ("bad COMPLEX kindtype" == NULL);
  2097.       break;
  2098.     }
  2099.       break;
  2100.  
  2101.     case FFEINFO_basictypeCHARACTER:
  2102.       switch (kt)
  2103.     {
  2104. #if FFETARGET_okCHARACTER1
  2105.     case FFEINFO_kindtypeCHARACTER1:
  2106.       u.character1.length = 1;
  2107.       u.character1.text = array.character1 + offset;
  2108.       break;
  2109. #endif
  2110.  
  2111. #if FFETARGET_okCHARACTER2
  2112.     case FFEINFO_kindtypeCHARACTER2:
  2113.       u.character2.length = 1;
  2114.       u.character2.text = array.character2 + offset;
  2115.       break;
  2116. #endif
  2117.  
  2118. #if FFETARGET_okCHARACTER3
  2119.     case FFEINFO_kindtypeCHARACTER3:
  2120.       u.character3.length = 1;
  2121.       u.character3.text = array.character3 + offset;
  2122.       break;
  2123. #endif
  2124.  
  2125. #if FFETARGET_okCHARACTER4
  2126.     case FFEINFO_kindtypeCHARACTER4:
  2127.       u.character4.length = 1;
  2128.       u.character4.text = array.character4 + offset;
  2129.       break;
  2130. #endif
  2131.  
  2132. #if FFETARGET_okCHARACTER5
  2133.     case FFEINFO_kindtypeCHARACTER5:
  2134.       u.character5.length = 1;
  2135.       u.character5.text = array.character5 + offset;
  2136.       break;
  2137. #endif
  2138.  
  2139. #if FFETARGET_okCHARACTER6
  2140.     case FFEINFO_kindtypeCHARACTER6:
  2141.       u.character6.length = 1;
  2142.       u.character6.text = array.character6 + offset;
  2143.       break;
  2144. #endif
  2145.  
  2146. #if FFETARGET_okCHARACTER7
  2147.     case FFEINFO_kindtypeCHARACTER7:
  2148.       u.character7.length = 1;
  2149.       u.character7.text = array.character7 + offset;
  2150.       break;
  2151. #endif
  2152.  
  2153. #if FFETARGET_okCHARACTER8
  2154.     case FFEINFO_kindtypeCHARACTER8:
  2155.       u.character8.length = 1;
  2156.       u.character8.text = array.character8 + offset;
  2157.       break;
  2158. #endif
  2159.  
  2160.     default:
  2161.       assert ("bad CHARACTER kindtype" == NULL);
  2162.       break;
  2163.     }
  2164.       break;
  2165.  
  2166.     default:
  2167.       assert ("bad basictype" == NULL);
  2168.       break;
  2169.     }
  2170.  
  2171.   return u;
  2172. }
  2173.  
  2174. /* ffebld_constantarray_new -- Make an array of constants
  2175.  
  2176.    See prototype.  */
  2177.  
  2178. ffebldConstantArray
  2179. ffebld_constantarray_new (ffeinfoBasictype bt,
  2180.               ffeinfoKindtype kt, ffetargetOffset size)
  2181. {
  2182.   ffebldConstantArray ptr;
  2183.  
  2184.   switch (bt)
  2185.     {
  2186.     case FFEINFO_basictypeINTEGER:
  2187.       switch (kt)
  2188.     {
  2189. #if FFETARGET_okINTEGER1
  2190.     case FFEINFO_kindtypeINTEGER1:
  2191.       ptr.integer1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2192.           "ffebldConstantArray", size *= sizeof (ffetargetInteger1), 0);
  2193.       break;
  2194. #endif
  2195.  
  2196. #if FFETARGET_okINTEGER2
  2197.     case FFEINFO_kindtypeINTEGER2:
  2198.       ptr.integer2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2199.           "ffebldConstantArray", size *= sizeof (ffetargetInteger2), 0);
  2200.       break;
  2201. #endif
  2202.  
  2203. #if FFETARGET_okINTEGER3
  2204.     case FFEINFO_kindtypeINTEGER3:
  2205.       ptr.integer3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2206.           "ffebldConstantArray", size *= sizeof (ffetargetInteger3), 0);
  2207.       break;
  2208. #endif
  2209.  
  2210. #if FFETARGET_okINTEGER4
  2211.     case FFEINFO_kindtypeINTEGER4:
  2212.       ptr.integer4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2213.           "ffebldConstantArray", size *= sizeof (ffetargetInteger4), 0);
  2214.       break;
  2215. #endif
  2216.  
  2217. #if FFETARGET_okINTEGER5
  2218.     case FFEINFO_kindtypeINTEGER5:
  2219.       ptr.integer5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2220.           "ffebldConstantArray", size *= sizeof (ffetargetInteger5), 0);
  2221.       break;
  2222. #endif
  2223.  
  2224. #if FFETARGET_okINTEGER6
  2225.     case FFEINFO_kindtypeINTEGER6:
  2226.       ptr.integer6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2227.           "ffebldConstantArray", size *= sizeof (ffetargetInteger6), 0);
  2228.       break;
  2229. #endif
  2230.  
  2231. #if FFETARGET_okINTEGER7
  2232.     case FFEINFO_kindtypeINTEGER7:
  2233.       ptr.integer7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2234.           "ffebldConstantArray", size *= sizeof (ffetargetInteger7), 0);
  2235.       break;
  2236. #endif
  2237.  
  2238. #if FFETARGET_okINTEGER8
  2239.     case FFEINFO_kindtypeINTEGER8:
  2240.       ptr.integer8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2241.           "ffebldConstantArray", size *= sizeof (ffetargetInteger8), 0);
  2242.       break;
  2243. #endif
  2244.  
  2245.     default:
  2246.       assert ("bad INTEGER kindtype" == NULL);
  2247.       break;
  2248.     }
  2249.       break;
  2250.  
  2251.     case FFEINFO_basictypeLOGICAL:
  2252.       switch (kt)
  2253.     {
  2254. #if FFETARGET_okLOGICAL1
  2255.     case FFEINFO_kindtypeLOGICAL1:
  2256.       ptr.logical1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2257.           "ffebldConstantArray", size *= sizeof (ffetargetLogical1), 0);
  2258.       break;
  2259. #endif
  2260.  
  2261. #if FFETARGET_okLOGICAL2
  2262.     case FFEINFO_kindtypeLOGICAL2:
  2263.       ptr.logical2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2264.           "ffebldConstantArray", size *= sizeof (ffetargetLogical2), 0);
  2265.       break;
  2266. #endif
  2267.  
  2268. #if FFETARGET_okLOGICAL3
  2269.     case FFEINFO_kindtypeLOGICAL3:
  2270.       ptr.logical3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2271.           "ffebldConstantArray", size *= sizeof (ffetargetLogical3), 0);
  2272.       break;
  2273. #endif
  2274.  
  2275. #if FFETARGET_okLOGICAL4
  2276.     case FFEINFO_kindtypeLOGICAL4:
  2277.       ptr.logical4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2278.           "ffebldConstantArray", size *= sizeof (ffetargetLogical4), 0);
  2279.       break;
  2280. #endif
  2281.  
  2282. #if FFETARGET_okLOGICAL5
  2283.     case FFEINFO_kindtypeLOGICAL5:
  2284.       ptr.logical5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2285.           "ffebldConstantArray", size *= sizeof (ffetargetLogical5), 0);
  2286.       break;
  2287. #endif
  2288.  
  2289. #if FFETARGET_okLOGICAL6
  2290.     case FFEINFO_kindtypeLOGICAL6:
  2291.       ptr.logical6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2292.           "ffebldConstantArray", size *= sizeof (ffetargetLogical6), 0);
  2293.       break;
  2294. #endif
  2295.  
  2296. #if FFETARGET_okLOGICAL7
  2297.     case FFEINFO_kindtypeLOGICAL7:
  2298.       ptr.logical7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2299.           "ffebldConstantArray", size *= sizeof (ffetargetLogical7), 0);
  2300.       break;
  2301. #endif
  2302.  
  2303. #if FFETARGET_okLOGICAL8
  2304.     case FFEINFO_kindtypeLOGICAL8:
  2305.       ptr.logical8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2306.           "ffebldConstantArray", size *= sizeof (ffetargetLogical8), 0);
  2307.       break;
  2308. #endif
  2309.  
  2310.     default:
  2311.       assert ("bad LOGICAL kindtype" == NULL);
  2312.       break;
  2313.     }
  2314.       break;
  2315.  
  2316.     case FFEINFO_basictypeREAL:
  2317.       switch (kt)
  2318.     {
  2319. #if FFETARGET_okREAL1
  2320.     case FFEINFO_kindtypeREAL1:
  2321.       ptr.real1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2322.          "ffebldConstantArray", size *= sizeof (ffetargetReal1), 0);
  2323.       break;
  2324. #endif
  2325.  
  2326. #if FFETARGET_okREAL2
  2327.     case FFEINFO_kindtypeREAL2:
  2328.       ptr.real2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2329.          "ffebldConstantArray", size *= sizeof (ffetargetReal2), 0);
  2330.       break;
  2331. #endif
  2332.  
  2333. #if FFETARGET_okREAL3
  2334.     case FFEINFO_kindtypeREAL3:
  2335.       ptr.real3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2336.          "ffebldConstantArray", size *= sizeof (ffetargetReal3), 0);
  2337.       break;
  2338. #endif
  2339.  
  2340. #if FFETARGET_okREAL4
  2341.     case FFEINFO_kindtypeREAL4:
  2342.       ptr.real4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2343.          "ffebldConstantArray", size *= sizeof (ffetargetReal4), 0);
  2344.       break;
  2345. #endif
  2346.  
  2347. #if FFETARGET_okREAL5
  2348.     case FFEINFO_kindtypeREAL5:
  2349.       ptr.real5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2350.          "ffebldConstantArray", size *= sizeof (ffetargetReal5), 0);
  2351.       break;
  2352. #endif
  2353.  
  2354. #if FFETARGET_okREAL6
  2355.     case FFEINFO_kindtypeREAL6:
  2356.       ptr.real6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2357.          "ffebldConstantArray", size *= sizeof (ffetargetReal6), 0);
  2358.       break;
  2359. #endif
  2360.  
  2361. #if FFETARGET_okREAL7
  2362.     case FFEINFO_kindtypeREAL7:
  2363.       ptr.real7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2364.          "ffebldConstantArray", size *= sizeof (ffetargetReal7), 0);
  2365.       break;
  2366. #endif
  2367.  
  2368. #if FFETARGET_okREAL8
  2369.     case FFEINFO_kindtypeREAL8:
  2370.       ptr.real8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2371.          "ffebldConstantArray", size *= sizeof (ffetargetReal8), 0);
  2372.       break;
  2373. #endif
  2374.  
  2375.     default:
  2376.       assert ("bad REAL kindtype" == NULL);
  2377.       break;
  2378.     }
  2379.       break;
  2380.  
  2381.     case FFEINFO_basictypeCOMPLEX:
  2382.       switch (kt)
  2383.     {
  2384. #if FFETARGET_okCOMPLEX1
  2385.     case FFEINFO_kindtypeREAL1:
  2386.       ptr.complex1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2387.           "ffebldConstantArray", size *= sizeof (ffetargetComplex1), 0);
  2388.       break;
  2389. #endif
  2390.  
  2391. #if FFETARGET_okCOMPLEX2
  2392.     case FFEINFO_kindtypeREAL2:
  2393.       ptr.complex2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2394.           "ffebldConstantArray", size *= sizeof (ffetargetComplex2), 0);
  2395.       break;
  2396. #endif
  2397.  
  2398. #if FFETARGET_okCOMPLEX3
  2399.     case FFEINFO_kindtypeREAL3:
  2400.       ptr.complex3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2401.           "ffebldConstantArray", size *= sizeof (ffetargetComplex3), 0);
  2402.       break;
  2403. #endif
  2404.  
  2405. #if FFETARGET_okCOMPLEX4
  2406.     case FFEINFO_kindtypeREAL4:
  2407.       ptr.complex4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2408.           "ffebldConstantArray", size *= sizeof (ffetargetComplex4), 0);
  2409.       break;
  2410. #endif
  2411.  
  2412. #if FFETARGET_okCOMPLEX5
  2413.     case FFEINFO_kindtypeREAL5:
  2414.       ptr.complex5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2415.           "ffebldConstantArray", size *= sizeof (ffetargetComplex5), 0);
  2416.       break;
  2417. #endif
  2418.  
  2419. #if FFETARGET_okCOMPLEX6
  2420.     case FFEINFO_kindtypeREAL6:
  2421.       ptr.complex6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2422.           "ffebldConstantArray", size *= sizeof (ffetargetComplex6), 0);
  2423.       break;
  2424. #endif
  2425.  
  2426. #if FFETARGET_okCOMPLEX7
  2427.     case FFEINFO_kindtypeREAL7:
  2428.       ptr.complex7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2429.           "ffebldConstantArray", size *= sizeof (ffetargetComplex7), 0);
  2430.       break;
  2431. #endif
  2432.  
  2433. #if FFETARGET_okCOMPLEX8
  2434.     case FFEINFO_kindtypeREAL8:
  2435.       ptr.complex8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2436.           "ffebldConstantArray", size *= sizeof (ffetargetComplex8), 0);
  2437.       break;
  2438. #endif
  2439.  
  2440.     default:
  2441.       assert ("bad COMPLEX kindtype" == NULL);
  2442.       break;
  2443.     }
  2444.       break;
  2445.  
  2446.     case FFEINFO_basictypeCHARACTER:
  2447.       switch (kt)
  2448.     {
  2449. #if FFETARGET_okCHARACTER1
  2450.     case FFEINFO_kindtypeCHARACTER1:
  2451.       ptr.character1 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2452.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit1),
  2453.                        0);
  2454.       break;
  2455. #endif
  2456.  
  2457. #if FFETARGET_okCHARACTER2
  2458.     case FFEINFO_kindtypeCHARACTER2:
  2459.       ptr.character2 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2460.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit2),
  2461.                        0);
  2462.       break;
  2463. #endif
  2464.  
  2465. #if FFETARGET_okCHARACTER3
  2466.     case FFEINFO_kindtypeCHARACTER3:
  2467.       ptr.character3 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2468.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit3),
  2469.                        0);
  2470.       break;
  2471. #endif
  2472.  
  2473. #if FFETARGET_okCHARACTER4
  2474.     case FFEINFO_kindtypeCHARACTER4:
  2475.       ptr.character4 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2476.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit4),
  2477.                        0);
  2478.       break;
  2479. #endif
  2480.  
  2481. #if FFETARGET_okCHARACTER5
  2482.     case FFEINFO_kindtypeCHARACTER5:
  2483.       ptr.character5 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2484.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit5),
  2485.                        0);
  2486.       break;
  2487. #endif
  2488.  
  2489. #if FFETARGET_okCHARACTER6
  2490.     case FFEINFO_kindtypeCHARACTER6:
  2491.       ptr.character6 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2492.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit6),
  2493.                        0);
  2494.       break;
  2495. #endif
  2496.  
  2497. #if FFETARGET_okCHARACTER7
  2498.     case FFEINFO_kindtypeCHARACTER7:
  2499.       ptr.character7 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2500.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit7),
  2501.                        0);
  2502.       break;
  2503. #endif
  2504.  
  2505. #if FFETARGET_okCHARACTER8
  2506.     case FFEINFO_kindtypeCHARACTER8:
  2507.       ptr.character8 = malloc_new_zkp (FFEBLD_CONSTANT_POOL_,
  2508.         "ffebldConstantArray", size *= sizeof (ffetargetCharacterUnit8),
  2509.                        0);
  2510.       break;
  2511. #endif
  2512.  
  2513.     default:
  2514.       assert ("bad CHARACTER kindtype" == NULL);
  2515.       break;
  2516.     }
  2517.       break;
  2518.  
  2519.     default:
  2520.       assert ("bad basictype" == NULL);
  2521.       break;
  2522.     }
  2523.  
  2524.   return ptr;
  2525. }
  2526.  
  2527. /* ffebld_constantarray_preparray -- Prepare for copy between arrays
  2528.  
  2529.    See prototype.
  2530.  
  2531.    Like _prepare, but the source is an array instead of a single-value
  2532.    constant.  */
  2533.  
  2534. void
  2535. ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
  2536.        ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
  2537.            ffetargetOffset offset, ffebldConstantArray source_array,
  2538.                 ffeinfoBasictype cbt, ffeinfoKindtype ckt)
  2539. {
  2540.   switch (abt)
  2541.     {
  2542.     case FFEINFO_basictypeINTEGER:
  2543.       switch (akt)
  2544.     {
  2545. #if FFETARGET_okINTEGER1
  2546.     case FFEINFO_kindtypeINTEGER1:
  2547.       *aptr = array.integer1 + offset;
  2548.       break;
  2549. #endif
  2550.  
  2551. #if FFETARGET_okINTEGER2
  2552.     case FFEINFO_kindtypeINTEGER2:
  2553.       *aptr = array.integer2 + offset;
  2554.       break;
  2555. #endif
  2556.  
  2557. #if FFETARGET_okINTEGER3
  2558.     case FFEINFO_kindtypeINTEGER3:
  2559.       *aptr = array.integer3 + offset;
  2560.       break;
  2561. #endif
  2562.  
  2563. #if FFETARGET_okINTEGER4
  2564.     case FFEINFO_kindtypeINTEGER4:
  2565.       *aptr = array.integer4 + offset;
  2566.       break;
  2567. #endif
  2568.  
  2569. #if FFETARGET_okINTEGER5
  2570.     case FFEINFO_kindtypeINTEGER5:
  2571.       *aptr = array.integer5 + offset;
  2572.       break;
  2573. #endif
  2574.  
  2575. #if FFETARGET_okINTEGER6
  2576.     case FFEINFO_kindtypeINTEGER6:
  2577.       *aptr = array.integer6 + offset;
  2578.       break;
  2579. #endif
  2580.  
  2581. #if FFETARGET_okINTEGER7
  2582.     case FFEINFO_kindtypeINTEGER7:
  2583.       *aptr = array.integer7 + offset;
  2584.       break;
  2585. #endif
  2586.  
  2587. #if FFETARGET_okINTEGER8
  2588.     case FFEINFO_kindtypeINTEGER8:
  2589.       *aptr = array.integer8 + offset;
  2590.       break;
  2591. #endif
  2592.  
  2593.     default:
  2594.       assert ("bad INTEGER akindtype" == NULL);
  2595.       break;
  2596.     }
  2597.       break;
  2598.  
  2599.     case FFEINFO_basictypeLOGICAL:
  2600.       switch (akt)
  2601.     {
  2602. #if FFETARGET_okLOGICAL1
  2603.     case FFEINFO_kindtypeLOGICAL1:
  2604.       *aptr = array.logical1 + offset;
  2605.       break;
  2606. #endif
  2607.  
  2608. #if FFETARGET_okLOGICAL2
  2609.     case FFEINFO_kindtypeLOGICAL2:
  2610.       *aptr = array.logical2 + offset;
  2611.       break;
  2612. #endif
  2613.  
  2614. #if FFETARGET_okLOGICAL3
  2615.     case FFEINFO_kindtypeLOGICAL3:
  2616.       *aptr = array.logical3 + offset;
  2617.       break;
  2618. #endif
  2619.  
  2620. #if FFETARGET_okLOGICAL4
  2621.     case FFEINFO_kindtypeLOGICAL4:
  2622.       *aptr = array.logical4 + offset;
  2623.       break;
  2624. #endif
  2625.  
  2626. #if FFETARGET_okLOGICAL5
  2627.     case FFEINFO_kindtypeLOGICAL5:
  2628.       *aptr = array.logical5 + offset;
  2629.       break;
  2630. #endif
  2631.  
  2632. #if FFETARGET_okLOGICAL6
  2633.     case FFEINFO_kindtypeLOGICAL6:
  2634.       *aptr = array.logical6 + offset;
  2635.       break;
  2636. #endif
  2637.  
  2638. #if FFETARGET_okLOGICAL7
  2639.     case FFEINFO_kindtypeLOGICAL7:
  2640.       *aptr = array.logical7 + offset;
  2641.       break;
  2642. #endif
  2643.  
  2644. #if FFETARGET_okLOGICAL8
  2645.     case FFEINFO_kindtypeLOGICAL8:
  2646.       *aptr = array.logical8 + offset;
  2647.       break;
  2648. #endif
  2649.  
  2650.     default:
  2651.       assert ("bad LOGICAL akindtype" == NULL);
  2652.       break;
  2653.     }
  2654.       break;
  2655.  
  2656.     case FFEINFO_basictypeREAL:
  2657.       switch (akt)
  2658.     {
  2659. #if FFETARGET_okREAL1
  2660.     case FFEINFO_kindtypeREAL1:
  2661.       *aptr = array.real1 + offset;
  2662.       break;
  2663. #endif
  2664.  
  2665. #if FFETARGET_okREAL2
  2666.     case FFEINFO_kindtypeREAL2:
  2667.       *aptr = array.real2 + offset;
  2668.       break;
  2669. #endif
  2670.  
  2671. #if FFETARGET_okREAL3
  2672.     case FFEINFO_kindtypeREAL3:
  2673.       *aptr = array.real3 + offset;
  2674.       break;
  2675. #endif
  2676.  
  2677. #if FFETARGET_okREAL4
  2678.     case FFEINFO_kindtypeREAL4:
  2679.       *aptr = array.real4 + offset;
  2680.       break;
  2681. #endif
  2682.  
  2683. #if FFETARGET_okREAL5
  2684.     case FFEINFO_kindtypeREAL5:
  2685.       *aptr = array.real5 + offset;
  2686.       break;
  2687. #endif
  2688.  
  2689. #if FFETARGET_okREAL6
  2690.     case FFEINFO_kindtypeREAL6:
  2691.       *aptr = array.real6 + offset;
  2692.       break;
  2693. #endif
  2694.  
  2695. #if FFETARGET_okREAL7
  2696.     case FFEINFO_kindtypeREAL7:
  2697.       *aptr = array.real7 + offset;
  2698.       break;
  2699. #endif
  2700.  
  2701. #if FFETARGET_okREAL8
  2702.     case FFEINFO_kindtypeREAL8:
  2703.       *aptr = array.real8 + offset;
  2704.       break;
  2705. #endif
  2706.  
  2707.     default:
  2708.       assert ("bad REAL akindtype" == NULL);
  2709.       break;
  2710.     }
  2711.       break;
  2712.  
  2713.     case FFEINFO_basictypeCOMPLEX:
  2714.       switch (akt)
  2715.     {
  2716. #if FFETARGET_okCOMPLEX1
  2717.     case FFEINFO_kindtypeREAL1:
  2718.       *aptr = array.complex1 + offset;
  2719.       break;
  2720. #endif
  2721.  
  2722. #if FFETARGET_okCOMPLEX2
  2723.     case FFEINFO_kindtypeREAL2:
  2724.       *aptr = array.complex2 + offset;
  2725.       break;
  2726. #endif
  2727.  
  2728. #if FFETARGET_okCOMPLEX3
  2729.     case FFEINFO_kindtypeREAL3:
  2730.       *aptr = array.complex3 + offset;
  2731.       break;
  2732. #endif
  2733.  
  2734. #if FFETARGET_okCOMPLEX4
  2735.     case FFEINFO_kindtypeREAL4:
  2736.       *aptr = array.complex4 + offset;
  2737.       break;
  2738. #endif
  2739.  
  2740. #if FFETARGET_okCOMPLEX5
  2741.     case FFEINFO_kindtypeREAL5:
  2742.       *aptr = array.complex5 + offset;
  2743.       break;
  2744. #endif
  2745.  
  2746. #if FFETARGET_okCOMPLEX6
  2747.     case FFEINFO_kindtypeREAL6:
  2748.       *aptr = array.complex6 + offset;
  2749.       break;
  2750. #endif
  2751.  
  2752. #if FFETARGET_okCOMPLEX7
  2753.     case FFEINFO_kindtypeREAL7:
  2754.       *aptr = array.complex7 + offset;
  2755.       break;
  2756. #endif
  2757.  
  2758. #if FFETARGET_okCOMPLEX8
  2759.     case FFEINFO_kindtypeREAL8:
  2760.       *aptr = array.complex8 + offset;
  2761.       break;
  2762. #endif
  2763.  
  2764.     default:
  2765.       assert ("bad COMPLEX akindtype" == NULL);
  2766.       break;
  2767.     }
  2768.       break;
  2769.  
  2770.     case FFEINFO_basictypeCHARACTER:
  2771.       switch (akt)
  2772.     {
  2773. #if FFETARGET_okCHARACTER1
  2774.     case FFEINFO_kindtypeCHARACTER1:
  2775.       *aptr = array.character1 + offset;
  2776.       break;
  2777. #endif
  2778.  
  2779. #if FFETARGET_okCHARACTER2
  2780.     case FFEINFO_kindtypeCHARACTER2:
  2781.       *aptr = array.character2 + offset;
  2782.       break;
  2783. #endif
  2784.  
  2785. #if FFETARGET_okCHARACTER3
  2786.     case FFEINFO_kindtypeCHARACTER3:
  2787.       *aptr = array.character3 + offset;
  2788.       break;
  2789. #endif
  2790.  
  2791. #if FFETARGET_okCHARACTER4
  2792.     case FFEINFO_kindtypeCHARACTER4:
  2793.       *aptr = array.character4 + offset;
  2794.       break;
  2795. #endif
  2796.  
  2797. #if FFETARGET_okCHARACTER5
  2798.     case FFEINFO_kindtypeCHARACTER5:
  2799.       *aptr = array.character5 + offset;
  2800.       break;
  2801. #endif
  2802.  
  2803. #if FFETARGET_okCHARACTER6
  2804.     case FFEINFO_kindtypeCHARACTER6:
  2805.       *aptr = array.character6 + offset;
  2806.       break;
  2807. #endif
  2808.  
  2809. #if FFETARGET_okCHARACTER7
  2810.     case FFEINFO_kindtypeCHARACTER7:
  2811.       *aptr = array.character7 + offset;
  2812.       break;
  2813. #endif
  2814.  
  2815. #if FFETARGET_okCHARACTER8
  2816.     case FFEINFO_kindtypeCHARACTER8:
  2817.       *aptr = array.character8 + offset;
  2818.       break;
  2819. #endif
  2820.  
  2821.     default:
  2822.       assert ("bad CHARACTER akindtype" == NULL);
  2823.       break;
  2824.     }
  2825.       break;
  2826.  
  2827.     default:
  2828.       assert ("bad abasictype" == NULL);
  2829.       break;
  2830.     }
  2831.  
  2832.   switch (cbt)
  2833.     {
  2834.     case FFEINFO_basictypeINTEGER:
  2835.       switch (ckt)
  2836.     {
  2837. #if FFETARGET_okINTEGER1
  2838.     case FFEINFO_kindtypeINTEGER1:
  2839.       *cptr = source_array.integer1;
  2840.       *size = sizeof (*source_array.integer1);
  2841.       break;
  2842. #endif
  2843.  
  2844. #if FFETARGET_okINTEGER2
  2845.     case FFEINFO_kindtypeINTEGER2:
  2846.       *cptr = source_array.integer2;
  2847.       *size = sizeof (*source_array.integer2);
  2848.       break;
  2849. #endif
  2850.  
  2851. #if FFETARGET_okINTEGER3
  2852.     case FFEINFO_kindtypeINTEGER3:
  2853.       *cptr = source_array.integer3;
  2854.       *size = sizeof (*source_array.integer3);
  2855.       break;
  2856. #endif
  2857.  
  2858. #if FFETARGET_okINTEGER4
  2859.     case FFEINFO_kindtypeINTEGER4:
  2860.       *cptr = source_array.integer4;
  2861.       *size = sizeof (*source_array.integer4);
  2862.       break;
  2863. #endif
  2864.  
  2865. #if FFETARGET_okINTEGER5
  2866.     case FFEINFO_kindtypeINTEGER5:
  2867.       *cptr = source_array.integer5;
  2868.       *size = sizeof (*source_array.integer5);
  2869.       break;
  2870. #endif
  2871.  
  2872. #if FFETARGET_okINTEGER6
  2873.     case FFEINFO_kindtypeINTEGER6:
  2874.       *cptr = source_array.integer6;
  2875.       *size = sizeof (*source_array.integer6);
  2876.       break;
  2877. #endif
  2878.  
  2879. #if FFETARGET_okINTEGER7
  2880.     case FFEINFO_kindtypeINTEGER7:
  2881.       *cptr = source_array.integer7;
  2882.       *size = sizeof (*source_array.integer7);
  2883.       break;
  2884. #endif
  2885.  
  2886. #if FFETARGET_okINTEGER8
  2887.     case FFEINFO_kindtypeINTEGER8:
  2888.       *cptr = source_array.integer8;
  2889.       *size = sizeof (*source_array.integer8);
  2890.       break;
  2891. #endif
  2892.  
  2893.     default:
  2894.       assert ("bad INTEGER ckindtype" == NULL);
  2895.       break;
  2896.     }
  2897.       break;
  2898.  
  2899.     case FFEINFO_basictypeLOGICAL:
  2900.       switch (ckt)
  2901.     {
  2902. #if FFETARGET_okLOGICAL1
  2903.     case FFEINFO_kindtypeLOGICAL1:
  2904.       *cptr = source_array.logical1;
  2905.       *size = sizeof (*source_array.logical1);
  2906.       break;
  2907. #endif
  2908.  
  2909. #if FFETARGET_okLOGICAL2
  2910.     case FFEINFO_kindtypeLOGICAL2:
  2911.       *cptr = source_array.logical2;
  2912.       *size = sizeof (*source_array.logical2);
  2913.       break;
  2914. #endif
  2915.  
  2916. #if FFETARGET_okLOGICAL3
  2917.     case FFEINFO_kindtypeLOGICAL3:
  2918.       *cptr = source_array.logical3;
  2919.       *size = sizeof (*source_array.logical3);
  2920.       break;
  2921. #endif
  2922.  
  2923. #if FFETARGET_okLOGICAL4
  2924.     case FFEINFO_kindtypeLOGICAL4:
  2925.       *cptr = source_array.logical4;
  2926.       *size = sizeof (*source_array.logical4);
  2927.       break;
  2928. #endif
  2929.  
  2930. #if FFETARGET_okLOGICAL5
  2931.     case FFEINFO_kindtypeLOGICAL5:
  2932.       *cptr = source_array.logical5;
  2933.       *size = sizeof (*source_array.logical5);
  2934.       break;
  2935. #endif
  2936.  
  2937. #if FFETARGET_okLOGICAL6
  2938.     case FFEINFO_kindtypeLOGICAL6:
  2939.       *cptr = source_array.logical6;
  2940.       *size = sizeof (*source_array.logical6);
  2941.       break;
  2942. #endif
  2943.  
  2944. #if FFETARGET_okLOGICAL7
  2945.     case FFEINFO_kindtypeLOGICAL7:
  2946.       *cptr = source_array.logical7;
  2947.       *size = sizeof (*source_array.logical7);
  2948.       break;
  2949. #endif
  2950.  
  2951. #if FFETARGET_okLOGICAL8
  2952.     case FFEINFO_kindtypeLOGICAL8:
  2953.       *cptr = source_array.logical8;
  2954.       *size = sizeof (*source_array.logical8);
  2955.       break;
  2956. #endif
  2957.  
  2958.     default:
  2959.       assert ("bad LOGICAL ckindtype" == NULL);
  2960.       break;
  2961.     }
  2962.       break;
  2963.  
  2964.     case FFEINFO_basictypeREAL:
  2965.       switch (ckt)
  2966.     {
  2967. #if FFETARGET_okREAL1
  2968.     case FFEINFO_kindtypeREAL1:
  2969.       *cptr = source_array.real1;
  2970.       *size = sizeof (*source_array.real1);
  2971.       break;
  2972. #endif
  2973.  
  2974. #if FFETARGET_okREAL2
  2975.     case FFEINFO_kindtypeREAL2:
  2976.       *cptr = source_array.real2;
  2977.       *size = sizeof (*source_array.real2);
  2978.       break;
  2979. #endif
  2980.  
  2981. #if FFETARGET_okREAL3
  2982.     case FFEINFO_kindtypeREAL3:
  2983.       *cptr = source_array.real3;
  2984.       *size = sizeof (*source_array.real3);
  2985.       break;
  2986. #endif
  2987.  
  2988. #if FFETARGET_okREAL4
  2989.     case FFEINFO_kindtypeREAL4:
  2990.       *cptr = source_array.real4;
  2991.       *size = sizeof (*source_array.real4);
  2992.       break;
  2993. #endif
  2994.  
  2995. #if FFETARGET_okREAL5
  2996.     case FFEINFO_kindtypeREAL5:
  2997.       *cptr = source_array.real5;
  2998.       *size = sizeof (*source_array.real5);
  2999.       break;
  3000. #endif
  3001.  
  3002. #if FFETARGET_okREAL6
  3003.     case FFEINFO_kindtypeREAL6:
  3004.       *cptr = source_array.real6;
  3005.       *size = sizeof (*source_array.real6);
  3006.       break;
  3007. #endif
  3008.  
  3009. #if FFETARGET_okREAL7
  3010.     case FFEINFO_kindtypeREAL7:
  3011.       *cptr = source_array.real7;
  3012.       *size = sizeof (*source_array.real7);
  3013.       break;
  3014. #endif
  3015.  
  3016. #if FFETARGET_okREAL8
  3017.     case FFEINFO_kindtypeREAL8:
  3018.       *cptr = source_array.real8;
  3019.       *size = sizeof (*source_array.real8);
  3020.       break;
  3021. #endif
  3022.  
  3023.     default:
  3024.       assert ("bad REAL ckindtype" == NULL);
  3025.       break;
  3026.     }
  3027.       break;
  3028.  
  3029.     case FFEINFO_basictypeCOMPLEX:
  3030.       switch (ckt)
  3031.     {
  3032. #if FFETARGET_okCOMPLEX1
  3033.     case FFEINFO_kindtypeREAL1:
  3034.       *cptr = source_array.complex1;
  3035.       *size = sizeof (*source_array.complex1);
  3036.       break;
  3037. #endif
  3038.  
  3039. #if FFETARGET_okCOMPLEX2
  3040.     case FFEINFO_kindtypeREAL2:
  3041.       *cptr = source_array.complex2;
  3042.       *size = sizeof (*source_array.complex2);
  3043.       break;
  3044. #endif
  3045.  
  3046. #if FFETARGET_okCOMPLEX3
  3047.     case FFEINFO_kindtypeREAL3:
  3048.       *cptr = source_array.complex3;
  3049.       *size = sizeof (*source_array.complex3);
  3050.       break;
  3051. #endif
  3052.  
  3053. #if FFETARGET_okCOMPLEX4
  3054.     case FFEINFO_kindtypeREAL4:
  3055.       *cptr = source_array.complex4;
  3056.       *size = sizeof (*source_array.complex4);
  3057.       break;
  3058. #endif
  3059.  
  3060. #if FFETARGET_okCOMPLEX5
  3061.     case FFEINFO_kindtypeREAL5:
  3062.       *cptr = source_array.complex5;
  3063.       *size = sizeof (*source_array.complex5);
  3064.       break;
  3065. #endif
  3066.  
  3067. #if FFETARGET_okCOMPLEX6
  3068.     case FFEINFO_kindtypeREAL6:
  3069.       *cptr = source_array.complex6;
  3070.       *size = sizeof (*source_array.complex6);
  3071.       break;
  3072. #endif
  3073.  
  3074. #if FFETARGET_okCOMPLEX7
  3075.     case FFEINFO_kindtypeREAL7:
  3076.       *cptr = source_array.complex7;
  3077.       *size = sizeof (*source_array.complex7);
  3078.       break;
  3079. #endif
  3080.  
  3081. #if FFETARGET_okCOMPLEX8
  3082.     case FFEINFO_kindtypeREAL8:
  3083.       *cptr = source_array.complex8;
  3084.       *size = sizeof (*source_array.complex8);
  3085.       break;
  3086. #endif
  3087.  
  3088.     default:
  3089.       assert ("bad COMPLEX ckindtype" == NULL);
  3090.       break;
  3091.     }
  3092.       break;
  3093.  
  3094.     case FFEINFO_basictypeCHARACTER:
  3095.       switch (ckt)
  3096.     {
  3097. #if FFETARGET_okCHARACTER1
  3098.     case FFEINFO_kindtypeCHARACTER1:
  3099.       *cptr = source_array.character1;
  3100.       *size = sizeof (*source_array.character1);
  3101.       break;
  3102. #endif
  3103.  
  3104. #if FFETARGET_okCHARACTER2
  3105.     case FFEINFO_kindtypeCHARACTER2:
  3106.       *cptr = source_array.character2;
  3107.       *size = sizeof (*source_array.character2);
  3108.       break;
  3109. #endif
  3110.  
  3111. #if FFETARGET_okCHARACTER3
  3112.     case FFEINFO_kindtypeCHARACTER3:
  3113.       *cptr = source_array.character3;
  3114.       *size = sizeof (*source_array.character3);
  3115.       break;
  3116. #endif
  3117.  
  3118. #if FFETARGET_okCHARACTER4
  3119.     case FFEINFO_kindtypeCHARACTER4:
  3120.       *cptr = source_array.character4;
  3121.       *size = sizeof (*source_array.character4);
  3122.       break;
  3123. #endif
  3124.  
  3125. #if FFETARGET_okCHARACTER5
  3126.     case FFEINFO_kindtypeCHARACTER5:
  3127.       *cptr = source_array.character5;
  3128.       *size = sizeof (*source_array.character5);
  3129.       break;
  3130. #endif
  3131.  
  3132. #if FFETARGET_okCHARACTER6
  3133.     case FFEINFO_kindtypeCHARACTER6:
  3134.       *cptr = source_array.character6;
  3135.       *size = sizeof (*source_array.character6);
  3136.       break;
  3137. #endif
  3138.  
  3139. #if FFETARGET_okCHARACTER7
  3140.     case FFEINFO_kindtypeCHARACTER7:
  3141.       *cptr = source_array.character7;
  3142.       *size = sizeof (*source_array.character7);
  3143.       break;
  3144. #endif
  3145.  
  3146. #if FFETARGET_okCHARACTER8
  3147.     case FFEINFO_kindtypeCHARACTER8:
  3148.       *cptr = source_array.character8;
  3149.       *size = sizeof (*source_array.character8);
  3150.       break;
  3151. #endif
  3152.  
  3153.     default:
  3154.       assert ("bad CHARACTER ckindtype" == NULL);
  3155.       break;
  3156.     }
  3157.       break;
  3158.  
  3159.     default:
  3160.       assert ("bad cbasictype" == NULL);
  3161.       break;
  3162.     }
  3163. }
  3164.  
  3165. /* ffebld_constantarray_prepare -- Prepare for copy between value and array
  3166.  
  3167.    See prototype.
  3168.  
  3169.    Like _put, but just returns the pointers to the beginnings of the
  3170.    array and the constant and returns the size (the amount of info to
  3171.    copy).  The idea is that the caller can use memcpy to accomplish the
  3172.    same thing as _put (though slower), or the caller can use a different
  3173.    function that swaps bytes, words, etc for a different target machine.
  3174.    Also, the type of the array may be different from the type of the
  3175.    constant; the array type is used to determine the meaning (scale) of
  3176.    the offset field (to calculate the array pointer), the constant type is
  3177.    used to determine the constant pointer and the size (amount of info to
  3178.    copy).  */
  3179.  
  3180. void
  3181. ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
  3182.        ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
  3183.               ffetargetOffset offset, ffebldConstantUnion *constant,
  3184.                   ffeinfoBasictype cbt, ffeinfoKindtype ckt)
  3185. {
  3186.   switch (abt)
  3187.     {
  3188.     case FFEINFO_basictypeINTEGER:
  3189.       switch (akt)
  3190.     {
  3191. #if FFETARGET_okINTEGER1
  3192.     case FFEINFO_kindtypeINTEGER1:
  3193.       *aptr = array.integer1 + offset;
  3194.       break;
  3195. #endif
  3196.  
  3197. #if FFETARGET_okINTEGER2
  3198.     case FFEINFO_kindtypeINTEGER2:
  3199.       *aptr = array.integer2 + offset;
  3200.       break;
  3201. #endif
  3202.  
  3203. #if FFETARGET_okINTEGER3
  3204.     case FFEINFO_kindtypeINTEGER3:
  3205.       *aptr = array.integer3 + offset;
  3206.       break;
  3207. #endif
  3208.  
  3209. #if FFETARGET_okINTEGER4
  3210.     case FFEINFO_kindtypeINTEGER4:
  3211.       *aptr = array.integer4 + offset;
  3212.       break;
  3213. #endif
  3214.  
  3215. #if FFETARGET_okINTEGER5
  3216.     case FFEINFO_kindtypeINTEGER5:
  3217.       *aptr = array.integer5 + offset;
  3218.       break;
  3219. #endif
  3220.  
  3221. #if FFETARGET_okINTEGER6
  3222.     case FFEINFO_kindtypeINTEGER6:
  3223.       *aptr = array.integer6 + offset;
  3224.       break;
  3225. #endif
  3226.  
  3227. #if FFETARGET_okINTEGER7
  3228.     case FFEINFO_kindtypeINTEGER7:
  3229.       *aptr = array.integer7 + offset;
  3230.       break;
  3231. #endif
  3232.  
  3233. #if FFETARGET_okINTEGER8
  3234.     case FFEINFO_kindtypeINTEGER8:
  3235.       *aptr = array.integer8 + offset;
  3236.       break;
  3237. #endif
  3238.  
  3239.     default:
  3240.       assert ("bad INTEGER akindtype" == NULL);
  3241.       break;
  3242.     }
  3243.       break;
  3244.  
  3245.     case FFEINFO_basictypeLOGICAL:
  3246.       switch (akt)
  3247.     {
  3248. #if FFETARGET_okLOGICAL1
  3249.     case FFEINFO_kindtypeLOGICAL1:
  3250.       *aptr = array.logical1 + offset;
  3251.       break;
  3252. #endif
  3253.  
  3254. #if FFETARGET_okLOGICAL2
  3255.     case FFEINFO_kindtypeLOGICAL2:
  3256.       *aptr = array.logical2 + offset;
  3257.       break;
  3258. #endif
  3259.  
  3260. #if FFETARGET_okLOGICAL3
  3261.     case FFEINFO_kindtypeLOGICAL3:
  3262.       *aptr = array.logical3 + offset;
  3263.       break;
  3264. #endif
  3265.  
  3266. #if FFETARGET_okLOGICAL4
  3267.     case FFEINFO_kindtypeLOGICAL4:
  3268.       *aptr = array.logical4 + offset;
  3269.       break;
  3270. #endif
  3271.  
  3272. #if FFETARGET_okLOGICAL5
  3273.     case FFEINFO_kindtypeLOGICAL5:
  3274.       *aptr = array.logical5 + offset;
  3275.       break;
  3276. #endif
  3277.  
  3278. #if FFETARGET_okLOGICAL6
  3279.     case FFEINFO_kindtypeLOGICAL6:
  3280.       *aptr = array.logical6 + offset;
  3281.       break;
  3282. #endif
  3283.  
  3284. #if FFETARGET_okLOGICAL7
  3285.     case FFEINFO_kindtypeLOGICAL7:
  3286.       *aptr = array.logical7 + offset;
  3287.       break;
  3288. #endif
  3289.  
  3290. #if FFETARGET_okLOGICAL8
  3291.     case FFEINFO_kindtypeLOGICAL8:
  3292.       *aptr = array.logical8 + offset;
  3293.       break;
  3294. #endif
  3295.  
  3296.     default:
  3297.       assert ("bad LOGICAL akindtype" == NULL);
  3298.       break;
  3299.     }
  3300.       break;
  3301.  
  3302.     case FFEINFO_basictypeREAL:
  3303.       switch (akt)
  3304.     {
  3305. #if FFETARGET_okREAL1
  3306.     case FFEINFO_kindtypeREAL1:
  3307.       *aptr = array.real1 + offset;
  3308.       break;
  3309. #endif
  3310.  
  3311. #if FFETARGET_okREAL2
  3312.     case FFEINFO_kindtypeREAL2:
  3313.       *aptr = array.real2 + offset;
  3314.       break;
  3315. #endif
  3316.  
  3317. #if FFETARGET_okREAL3
  3318.     case FFEINFO_kindtypeREAL3:
  3319.       *aptr = array.real3 + offset;
  3320.       break;
  3321. #endif
  3322.  
  3323. #if FFETARGET_okREAL4
  3324.     case FFEINFO_kindtypeREAL4:
  3325.       *aptr = array.real4 + offset;
  3326.       break;
  3327. #endif
  3328.  
  3329. #if FFETARGET_okREAL5
  3330.     case FFEINFO_kindtypeREAL5:
  3331.       *aptr = array.real5 + offset;
  3332.       break;
  3333. #endif
  3334.  
  3335. #if FFETARGET_okREAL6
  3336.     case FFEINFO_kindtypeREAL6:
  3337.       *aptr = array.real6 + offset;
  3338.       break;
  3339. #endif
  3340.  
  3341. #if FFETARGET_okREAL7
  3342.     case FFEINFO_kindtypeREAL7:
  3343.       *aptr = array.real7 + offset;
  3344.       break;
  3345. #endif
  3346.  
  3347. #if FFETARGET_okREAL8
  3348.     case FFEINFO_kindtypeREAL8:
  3349.       *aptr = array.real8 + offset;
  3350.       break;
  3351. #endif
  3352.  
  3353.     default:
  3354.       assert ("bad REAL akindtype" == NULL);
  3355.       break;
  3356.     }
  3357.       break;
  3358.  
  3359.     case FFEINFO_basictypeCOMPLEX:
  3360.       switch (akt)
  3361.     {
  3362. #if FFETARGET_okCOMPLEX1
  3363.     case FFEINFO_kindtypeREAL1:
  3364.       *aptr = array.complex1 + offset;
  3365.       break;
  3366. #endif
  3367.  
  3368. #if FFETARGET_okCOMPLEX2
  3369.     case FFEINFO_kindtypeREAL2:
  3370.       *aptr = array.complex2 + offset;
  3371.       break;
  3372. #endif
  3373.  
  3374. #if FFETARGET_okCOMPLEX3
  3375.     case FFEINFO_kindtypeREAL3:
  3376.       *aptr = array.complex3 + offset;
  3377.       break;
  3378. #endif
  3379.  
  3380. #if FFETARGET_okCOMPLEX4
  3381.     case FFEINFO_kindtypeREAL4:
  3382.       *aptr = array.complex4 + offset;
  3383.       break;
  3384. #endif
  3385.  
  3386. #if FFETARGET_okCOMPLEX5
  3387.     case FFEINFO_kindtypeREAL5:
  3388.       *aptr = array.complex5 + offset;
  3389.       break;
  3390. #endif
  3391.  
  3392. #if FFETARGET_okCOMPLEX6
  3393.     case FFEINFO_kindtypeREAL6:
  3394.       *aptr = array.complex6 + offset;
  3395.       break;
  3396. #endif
  3397.  
  3398. #if FFETARGET_okCOMPLEX7
  3399.     case FFEINFO_kindtypeREAL7:
  3400.       *aptr = array.complex7 + offset;
  3401.       break;
  3402. #endif
  3403.  
  3404. #if FFETARGET_okCOMPLEX8
  3405.     case FFEINFO_kindtypeREAL8:
  3406.       *aptr = array.complex8 + offset;
  3407.       break;
  3408. #endif
  3409.  
  3410.     default:
  3411.       assert ("bad COMPLEX akindtype" == NULL);
  3412.       break;
  3413.     }
  3414.       break;
  3415.  
  3416.     case FFEINFO_basictypeCHARACTER:
  3417.       switch (akt)
  3418.     {
  3419. #if FFETARGET_okCHARACTER1
  3420.     case FFEINFO_kindtypeCHARACTER1:
  3421.       *aptr = array.character1 + offset;
  3422.       break;
  3423. #endif
  3424.  
  3425. #if FFETARGET_okCHARACTER2
  3426.     case FFEINFO_kindtypeCHARACTER2:
  3427.       *aptr = array.character2 + offset;
  3428.       break;
  3429. #endif
  3430.  
  3431. #if FFETARGET_okCHARACTER3
  3432.     case FFEINFO_kindtypeCHARACTER3:
  3433.       *aptr = array.character3 + offset;
  3434.       break;
  3435. #endif
  3436.  
  3437. #if FFETARGET_okCHARACTER4
  3438.     case FFEINFO_kindtypeCHARACTER4:
  3439.       *aptr = array.character4 + offset;
  3440.       break;
  3441. #endif
  3442.  
  3443. #if FFETARGET_okCHARACTER5
  3444.     case FFEINFO_kindtypeCHARACTER5:
  3445.       *aptr = array.character5 + offset;
  3446.       break;
  3447. #endif
  3448.  
  3449. #if FFETARGET_okCHARACTER6
  3450.     case FFEINFO_kindtypeCHARACTER6:
  3451.       *aptr = array.character6 + offset;
  3452.       break;
  3453. #endif
  3454.  
  3455. #if FFETARGET_okCHARACTER7
  3456.     case FFEINFO_kindtypeCHARACTER7:
  3457.       *aptr = array.character7 + offset;
  3458.       break;
  3459. #endif
  3460.  
  3461. #if FFETARGET_okCHARACTER8
  3462.     case FFEINFO_kindtypeCHARACTER8:
  3463.       *aptr = array.character8 + offset;
  3464.       break;
  3465. #endif
  3466.  
  3467.     default:
  3468.       assert ("bad CHARACTER akindtype" == NULL);
  3469.       break;
  3470.     }
  3471.       break;
  3472.  
  3473.     default:
  3474.       assert ("bad abasictype" == NULL);
  3475.       break;
  3476.     }
  3477.  
  3478.   switch (cbt)
  3479.     {
  3480.     case FFEINFO_basictypeINTEGER:
  3481.       switch (ckt)
  3482.     {
  3483. #if FFETARGET_okINTEGER1
  3484.     case FFEINFO_kindtypeINTEGER1:
  3485.       *cptr = &constant->integer1;
  3486.       *size = sizeof (constant->integer1);
  3487.       break;
  3488. #endif
  3489.  
  3490. #if FFETARGET_okINTEGER2
  3491.     case FFEINFO_kindtypeINTEGER2:
  3492.       *cptr = &constant->integer2;
  3493.       *size = sizeof (constant->integer2);
  3494.       break;
  3495. #endif
  3496.  
  3497. #if FFETARGET_okINTEGER3
  3498.     case FFEINFO_kindtypeINTEGER3:
  3499.       *cptr = &constant->integer3;
  3500.       *size = sizeof (constant->integer3);
  3501.       break;
  3502. #endif
  3503.  
  3504. #if FFETARGET_okINTEGER4
  3505.     case FFEINFO_kindtypeINTEGER4:
  3506.       *cptr = &constant->integer4;
  3507.       *size = sizeof (constant->integer4);
  3508.       break;
  3509. #endif
  3510.  
  3511. #if FFETARGET_okINTEGER5
  3512.     case FFEINFO_kindtypeINTEGER5:
  3513.       *cptr = &constant->integer5;
  3514.       *size = sizeof (constant->integer5);
  3515.       break;
  3516. #endif
  3517.  
  3518. #if FFETARGET_okINTEGER6
  3519.     case FFEINFO_kindtypeINTEGER6:
  3520.       *cptr = &constant->integer6;
  3521.       *size = sizeof (constant->integer6);
  3522.       break;
  3523. #endif
  3524.  
  3525. #if FFETARGET_okINTEGER7
  3526.     case FFEINFO_kindtypeINTEGER7:
  3527.       *cptr = &constant->integer7;
  3528.       *size = sizeof (constant->integer7);
  3529.       break;
  3530. #endif
  3531.  
  3532. #if FFETARGET_okINTEGER8
  3533.     case FFEINFO_kindtypeINTEGER8:
  3534.       *cptr = &constant->integer8;
  3535.       *size = sizeof (constant->integer8);
  3536.       break;
  3537. #endif
  3538.  
  3539.     default:
  3540.       assert ("bad INTEGER ckindtype" == NULL);
  3541.       break;
  3542.     }
  3543.       break;
  3544.  
  3545.     case FFEINFO_basictypeLOGICAL:
  3546.       switch (ckt)
  3547.     {
  3548. #if FFETARGET_okLOGICAL1
  3549.     case FFEINFO_kindtypeLOGICAL1:
  3550.       *cptr = &constant->logical1;
  3551.       *size = sizeof (constant->logical1);
  3552.       break;
  3553. #endif
  3554.  
  3555. #if FFETARGET_okLOGICAL2
  3556.     case FFEINFO_kindtypeLOGICAL2:
  3557.       *cptr = &constant->logical2;
  3558.       *size = sizeof (constant->logical2);
  3559.       break;
  3560. #endif
  3561.  
  3562. #if FFETARGET_okLOGICAL3
  3563.     case FFEINFO_kindtypeLOGICAL3:
  3564.       *cptr = &constant->logical3;
  3565.       *size = sizeof (constant->logical3);
  3566.       break;
  3567. #endif
  3568.  
  3569. #if FFETARGET_okLOGICAL4
  3570.     case FFEINFO_kindtypeLOGICAL4:
  3571.       *cptr = &constant->logical4;
  3572.       *size = sizeof (constant->logical4);
  3573.       break;
  3574. #endif
  3575.  
  3576. #if FFETARGET_okLOGICAL5
  3577.     case FFEINFO_kindtypeLOGICAL5:
  3578.       *cptr = &constant->logical5;
  3579.       *size = sizeof (constant->logical5);
  3580.       break;
  3581. #endif
  3582.  
  3583. #if FFETARGET_okLOGICAL6
  3584.     case FFEINFO_kindtypeLOGICAL6:
  3585.       *cptr = &constant->logical6;
  3586.       *size = sizeof (constant->logical6);
  3587.       break;
  3588. #endif
  3589.  
  3590. #if FFETARGET_okLOGICAL7
  3591.     case FFEINFO_kindtypeLOGICAL7:
  3592.       *cptr = &constant->logical7;
  3593.       *size = sizeof (constant->logical7);
  3594.       break;
  3595. #endif
  3596.  
  3597. #if FFETARGET_okLOGICAL8
  3598.     case FFEINFO_kindtypeLOGICAL8:
  3599.       *cptr = &constant->logical8;
  3600.       *size = sizeof (constant->logical8);
  3601.       break;
  3602. #endif
  3603.  
  3604.     default:
  3605.       assert ("bad LOGICAL ckindtype" == NULL);
  3606.       break;
  3607.     }
  3608.       break;
  3609.  
  3610.     case FFEINFO_basictypeREAL:
  3611.       switch (ckt)
  3612.     {
  3613. #if FFETARGET_okREAL1
  3614.     case FFEINFO_kindtypeREAL1:
  3615.       *cptr = &constant->real1;
  3616.       *size = sizeof (constant->real1);
  3617.       break;
  3618. #endif
  3619.  
  3620. #if FFETARGET_okREAL2
  3621.     case FFEINFO_kindtypeREAL2:
  3622.       *cptr = &constant->real2;
  3623.       *size = sizeof (constant->real2);
  3624.       break;
  3625. #endif
  3626.  
  3627. #if FFETARGET_okREAL3
  3628.     case FFEINFO_kindtypeREAL3:
  3629.       *cptr = &constant->real3;
  3630.       *size = sizeof (constant->real3);
  3631.       break;
  3632. #endif
  3633.  
  3634. #if FFETARGET_okREAL4
  3635.     case FFEINFO_kindtypeREAL4:
  3636.       *cptr = &constant->real4;
  3637.       *size = sizeof (constant->real4);
  3638.       break;
  3639. #endif
  3640.  
  3641. #if FFETARGET_okREAL5
  3642.     case FFEINFO_kindtypeREAL5:
  3643.       *cptr = &constant->real5;
  3644.       *size = sizeof (constant->real5);
  3645.       break;
  3646. #endif
  3647.  
  3648. #if FFETARGET_okREAL6
  3649.     case FFEINFO_kindtypeREAL6:
  3650.       *cptr = &constant->real6;
  3651.       *size = sizeof (constant->real6);
  3652.       break;
  3653. #endif
  3654.  
  3655. #if FFETARGET_okREAL7
  3656.     case FFEINFO_kindtypeREAL7:
  3657.       *cptr = &constant->real7;
  3658.       *size = sizeof (constant->real7);
  3659.       break;
  3660. #endif
  3661.  
  3662. #if FFETARGET_okREAL8
  3663.     case FFEINFO_kindtypeREAL8:
  3664.       *cptr = &constant->real8;
  3665.       *size = sizeof (constant->real8);
  3666.       break;
  3667. #endif
  3668.  
  3669.     default:
  3670.       assert ("bad REAL ckindtype" == NULL);
  3671.       break;
  3672.     }
  3673.       break;
  3674.  
  3675.     case FFEINFO_basictypeCOMPLEX:
  3676.       switch (ckt)
  3677.     {
  3678. #if FFETARGET_okCOMPLEX1
  3679.     case FFEINFO_kindtypeREAL1:
  3680.       *cptr = &constant->complex1;
  3681.       *size = sizeof (constant->complex1);
  3682.       break;
  3683. #endif
  3684.  
  3685. #if FFETARGET_okCOMPLEX2
  3686.     case FFEINFO_kindtypeREAL2:
  3687.       *cptr = &constant->complex2;
  3688.       *size = sizeof (constant->complex2);
  3689.       break;
  3690. #endif
  3691.  
  3692. #if FFETARGET_okCOMPLEX3
  3693.     case FFEINFO_kindtypeREAL3:
  3694.       *cptr = &constant->complex3;
  3695.       *size = sizeof (constant->complex3);
  3696.       break;
  3697. #endif
  3698.  
  3699. #if FFETARGET_okCOMPLEX4
  3700.     case FFEINFO_kindtypeREAL4:
  3701.       *cptr = &constant->complex4;
  3702.       *size = sizeof (constant->complex4);
  3703.       break;
  3704. #endif
  3705.  
  3706. #if FFETARGET_okCOMPLEX5
  3707.     case FFEINFO_kindtypeREAL5:
  3708.       *cptr = &constant->complex5;
  3709.       *size = sizeof (constant->complex5);
  3710.       break;
  3711. #endif
  3712.  
  3713. #if FFETARGET_okCOMPLEX6
  3714.     case FFEINFO_kindtypeREAL6:
  3715.       *cptr = &constant->complex6;
  3716.       *size = sizeof (constant->complex6);
  3717.       break;
  3718. #endif
  3719.  
  3720. #if FFETARGET_okCOMPLEX7
  3721.     case FFEINFO_kindtypeREAL7:
  3722.       *cptr = &constant->complex7;
  3723.       *size = sizeof (constant->complex7);
  3724.       break;
  3725. #endif
  3726.  
  3727. #if FFETARGET_okCOMPLEX8
  3728.     case FFEINFO_kindtypeREAL8:
  3729.       *cptr = &constant->complex8;
  3730.       *size = sizeof (constant->complex8);
  3731.       break;
  3732. #endif
  3733.  
  3734.     default:
  3735.       assert ("bad COMPLEX ckindtype" == NULL);
  3736.       break;
  3737.     }
  3738.       break;
  3739.  
  3740.     case FFEINFO_basictypeCHARACTER:
  3741.       switch (ckt)
  3742.     {
  3743. #if FFETARGET_okCHARACTER1
  3744.     case FFEINFO_kindtypeCHARACTER1:
  3745.       *cptr = ffetarget_text_character1 (constant->character1);
  3746.       *size = ffetarget_length_character1 (constant->character1);
  3747.       break;
  3748. #endif
  3749.  
  3750. #if FFETARGET_okCHARACTER2
  3751.     case FFEINFO_kindtypeCHARACTER2:
  3752.       *cptr = ffetarget_text_character2 (constant->character2);
  3753.       *size = ffetarget_length_character2 (constant->character2);
  3754.       break;
  3755. #endif
  3756.  
  3757. #if FFETARGET_okCHARACTER3
  3758.     case FFEINFO_kindtypeCHARACTER3:
  3759.       *cptr = ffetarget_text_character3 (constant->character3);
  3760.       *size = ffetarget_length_character3 (constant->character3);
  3761.       break;
  3762. #endif
  3763.  
  3764. #if FFETARGET_okCHARACTER4
  3765.     case FFEINFO_kindtypeCHARACTER4:
  3766.       *cptr = ffetarget_text_character4 (constant->character4);
  3767.       *size = ffetarget_length_character4 (constant->character4);
  3768.       break;
  3769. #endif
  3770.  
  3771. #if FFETARGET_okCHARACTER5
  3772.     case FFEINFO_kindtypeCHARACTER5:
  3773.       *cptr = ffetarget_text_character5 (constant->character5);
  3774.       *size = ffetarget_length_character5 (constant->character5);
  3775.       break;
  3776. #endif
  3777.  
  3778. #if FFETARGET_okCHARACTER6
  3779.     case FFEINFO_kindtypeCHARACTER6:
  3780.       *cptr = ffetarget_text_character6 (constant->character6);
  3781.       *size = ffetarget_length_character6 (constant->character6);
  3782.       break;
  3783. #endif
  3784.  
  3785. #if FFETARGET_okCHARACTER7
  3786.     case FFEINFO_kindtypeCHARACTER7:
  3787.       *cptr = ffetarget_text_character7 (constant->character7);
  3788.       *size = ffetarget_length_character7 (constant->character7);
  3789.       break;
  3790. #endif
  3791.  
  3792. #if FFETARGET_okCHARACTER8
  3793.     case FFEINFO_kindtypeCHARACTER8:
  3794.       *cptr = ffetarget_text_character8 (constant->character8);
  3795.       *size = ffetarget_length_character8 (constant->character8);
  3796.       break;
  3797. #endif
  3798.  
  3799.     default:
  3800.       assert ("bad CHARACTER ckindtype" == NULL);
  3801.       break;
  3802.     }
  3803.       break;
  3804.  
  3805.     default:
  3806.       assert ("bad cbasictype" == NULL);
  3807.       break;
  3808.     }
  3809. }
  3810.  
  3811. /* ffebld_constantarray_put -- Put a value into an array of constants
  3812.  
  3813.    See prototype.  */
  3814.  
  3815. void
  3816. ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
  3817.    ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant)
  3818. {
  3819.   switch (bt)
  3820.     {
  3821.     case FFEINFO_basictypeINTEGER:
  3822.       switch (kt)
  3823.     {
  3824. #if FFETARGET_okINTEGER1
  3825.     case FFEINFO_kindtypeINTEGER1:
  3826.       *(array.integer1 + offset) = constant.integer1;
  3827.       break;
  3828. #endif
  3829.  
  3830. #if FFETARGET_okINTEGER2
  3831.     case FFEINFO_kindtypeINTEGER2:
  3832.       *(array.integer2 + offset) = constant.integer2;
  3833.       break;
  3834. #endif
  3835.  
  3836. #if FFETARGET_okINTEGER3
  3837.     case FFEINFO_kindtypeINTEGER3:
  3838.       *(array.integer3 + offset) = constant.integer3;
  3839.       break;
  3840. #endif
  3841.  
  3842. #if FFETARGET_okINTEGER4
  3843.     case FFEINFO_kindtypeINTEGER4:
  3844.       *(array.integer4 + offset) = constant.integer4;
  3845.       break;
  3846. #endif
  3847.  
  3848. #if FFETARGET_okINTEGER5
  3849.     case FFEINFO_kindtypeINTEGER5:
  3850.       *(array.integer5 + offset) = constant.integer5;
  3851.       break;
  3852. #endif
  3853.  
  3854. #if FFETARGET_okINTEGER6
  3855.     case FFEINFO_kindtypeINTEGER6:
  3856.       *(array.integer6 + offset) = constant.integer6;
  3857.       break;
  3858. #endif
  3859.  
  3860. #if FFETARGET_okINTEGER7
  3861.     case FFEINFO_kindtypeINTEGER7:
  3862.       *(array.integer7 + offset) = constant.integer7;
  3863.       break;
  3864. #endif
  3865.  
  3866. #if FFETARGET_okINTEGER8
  3867.     case FFEINFO_kindtypeINTEGER8:
  3868.       *(array.integer8 + offset) = constant.integer8;
  3869.       break;
  3870. #endif
  3871.  
  3872.     default:
  3873.       assert ("bad INTEGER kindtype" == NULL);
  3874.       break;
  3875.     }
  3876.       break;
  3877.  
  3878.     case FFEINFO_basictypeLOGICAL:
  3879.       switch (kt)
  3880.     {
  3881. #if FFETARGET_okLOGICAL1
  3882.     case FFEINFO_kindtypeLOGICAL1:
  3883.       *(array.logical1 + offset) = constant.logical1;
  3884.       break;
  3885. #endif
  3886.  
  3887. #if FFETARGET_okLOGICAL2
  3888.     case FFEINFO_kindtypeLOGICAL2:
  3889.       *(array.logical2 + offset) = constant.logical2;
  3890.       break;
  3891. #endif
  3892.  
  3893. #if FFETARGET_okLOGICAL3
  3894.     case FFEINFO_kindtypeLOGICAL3:
  3895.       *(array.logical3 + offset) = constant.logical3;
  3896.       break;
  3897. #endif
  3898.  
  3899. #if FFETARGET_okLOGICAL4
  3900.     case FFEINFO_kindtypeLOGICAL4:
  3901.       *(array.logical4 + offset) = constant.logical4;
  3902.       break;
  3903. #endif
  3904.  
  3905. #if FFETARGET_okLOGICAL5
  3906.     case FFEINFO_kindtypeLOGICAL5:
  3907.       *(array.logical5 + offset) = constant.logical5;
  3908.       break;
  3909. #endif
  3910.  
  3911. #if FFETARGET_okLOGICAL6
  3912.     case FFEINFO_kindtypeLOGICAL6:
  3913.       *(array.logical6 + offset) = constant.logical6;
  3914.       break;
  3915. #endif
  3916.  
  3917. #if FFETARGET_okLOGICAL7
  3918.     case FFEINFO_kindtypeLOGICAL7:
  3919.       *(array.logical7 + offset) = constant.logical7;
  3920.       break;
  3921. #endif
  3922.  
  3923. #if FFETARGET_okLOGICAL8
  3924.     case FFEINFO_kindtypeLOGICAL8:
  3925.       *(array.logical8 + offset) = constant.logical8;
  3926.       break;
  3927. #endif
  3928.  
  3929.     default:
  3930.       assert ("bad LOGICAL kindtype" == NULL);
  3931.       break;
  3932.     }
  3933.       break;
  3934.  
  3935.     case FFEINFO_basictypeREAL:
  3936.       switch (kt)
  3937.     {
  3938. #if FFETARGET_okREAL1
  3939.     case FFEINFO_kindtypeREAL1:
  3940.       *(array.real1 + offset) = constant.real1;
  3941.       break;
  3942. #endif
  3943.  
  3944. #if FFETARGET_okREAL2
  3945.     case FFEINFO_kindtypeREAL2:
  3946.       *(array.real2 + offset) = constant.real2;
  3947.       break;
  3948. #endif
  3949.  
  3950. #if FFETARGET_okREAL3
  3951.     case FFEINFO_kindtypeREAL3:
  3952.       *(array.real3 + offset) = constant.real3;
  3953.       break;
  3954. #endif
  3955.  
  3956. #if FFETARGET_okREAL4
  3957.     case FFEINFO_kindtypeREAL4:
  3958.       *(array.real4 + offset) = constant.real4;
  3959.       break;
  3960. #endif
  3961.  
  3962. #if FFETARGET_okREAL5
  3963.     case FFEINFO_kindtypeREAL5:
  3964.       *(array.real5 + offset) = constant.real5;
  3965.       break;
  3966. #endif
  3967.  
  3968. #if FFETARGET_okREAL6
  3969.     case FFEINFO_kindtypeREAL6:
  3970.       *(array.real6 + offset) = constant.real6;
  3971.       break;
  3972. #endif
  3973.  
  3974. #if FFETARGET_okREAL7
  3975.     case FFEINFO_kindtypeREAL7:
  3976.       *(array.real7 + offset) = constant.real7;
  3977.       break;
  3978. #endif
  3979.  
  3980. #if FFETARGET_okREAL8
  3981.     case FFEINFO_kindtypeREAL8:
  3982.       *(array.real8 + offset) = constant.real8;
  3983.       break;
  3984. #endif
  3985.  
  3986.     default:
  3987.       assert ("bad REAL kindtype" == NULL);
  3988.       break;
  3989.     }
  3990.       break;
  3991.  
  3992.     case FFEINFO_basictypeCOMPLEX:
  3993.       switch (kt)
  3994.     {
  3995. #if FFETARGET_okCOMPLEX1
  3996.     case FFEINFO_kindtypeREAL1:
  3997.       *(array.complex1 + offset) = constant.complex1;
  3998.       break;
  3999. #endif
  4000.  
  4001. #if FFETARGET_okCOMPLEX2
  4002.     case FFEINFO_kindtypeREAL2:
  4003.       *(array.complex2 + offset) = constant.complex2;
  4004.       break;
  4005. #endif
  4006.  
  4007. #if FFETARGET_okCOMPLEX3
  4008.     case FFEINFO_kindtypeREAL3:
  4009.       *(array.complex3 + offset) = constant.complex3;
  4010.       break;
  4011. #endif
  4012.  
  4013. #if FFETARGET_okCOMPLEX4
  4014.     case FFEINFO_kindtypeREAL4:
  4015.       *(array.complex4 + offset) = constant.complex4;
  4016.       break;
  4017. #endif
  4018.  
  4019. #if FFETARGET_okCOMPLEX5
  4020.     case FFEINFO_kindtypeREAL5:
  4021.       *(array.complex5 + offset) = constant.complex5;
  4022.       break;
  4023. #endif
  4024.  
  4025. #if FFETARGET_okCOMPLEX6
  4026.     case FFEINFO_kindtypeREAL6:
  4027.       *(array.complex6 + offset) = constant.complex6;
  4028.       break;
  4029. #endif
  4030.  
  4031. #if FFETARGET_okCOMPLEX7
  4032.     case FFEINFO_kindtypeREAL7:
  4033.       *(array.complex7 + offset) = constant.complex7;
  4034.       break;
  4035. #endif
  4036.  
  4037. #if FFETARGET_okCOMPLEX8
  4038.     case FFEINFO_kindtypeREAL8:
  4039.       *(array.complex8 + offset) = constant.complex8;
  4040.       break;
  4041. #endif
  4042.  
  4043.     default:
  4044.       assert ("bad COMPLEX kindtype" == NULL);
  4045.       break;
  4046.     }
  4047.       break;
  4048.  
  4049.     case FFEINFO_basictypeCHARACTER:
  4050.       switch (kt)
  4051.     {
  4052. #if FFETARGET_okCHARACTER1
  4053.     case FFEINFO_kindtypeCHARACTER1:
  4054.       memcpy (array.character1 + offset,
  4055.           ffetarget_text_character1 (constant.character1),
  4056.           ffetarget_length_character1 (constant.character1));
  4057.       break;
  4058. #endif
  4059.  
  4060. #if FFETARGET_okCHARACTER2
  4061.     case FFEINFO_kindtypeCHARACTER2:
  4062.       memcpy (array.character2 + offset,
  4063.           ffetarget_text_character2 (constant.character2),
  4064.           ffetarget_length_character2 (constant.character2));
  4065.       break;
  4066. #endif
  4067.  
  4068. #if FFETARGET_okCHARACTER3
  4069.     case FFEINFO_kindtypeCHARACTER3:
  4070.       memcpy (array.character3 + offset,
  4071.           ffetarget_text_character3 (constant.character3),
  4072.           ffetarget_length_character3 (constant.character3));
  4073.       break;
  4074. #endif
  4075.  
  4076. #if FFETARGET_okCHARACTER4
  4077.     case FFEINFO_kindtypeCHARACTER4:
  4078.       memcpy (array.character4 + offset,
  4079.           ffetarget_text_character4 (constant.character4),
  4080.           ffetarget_length_character4 (constant.character4));
  4081.       break;
  4082. #endif
  4083.  
  4084. #if FFETARGET_okCHARACTER5
  4085.     case FFEINFO_kindtypeCHARACTER5:
  4086.       memcpy (array.character5 + offset,
  4087.           ffetarget_text_character5 (constant.character5),
  4088.           ffetarget_length_character5 (constant.character5));
  4089.       break;
  4090. #endif
  4091.  
  4092. #if FFETARGET_okCHARACTER6
  4093.     case FFEINFO_kindtypeCHARACTER6:
  4094.       memcpy (array.character6 + offset,
  4095.           ffetarget_text_character6 (constant.character6),
  4096.           ffetarget_length_character6 (constant.character6));
  4097.       break;
  4098. #endif
  4099.  
  4100. #if FFETARGET_okCHARACTER7
  4101.     case FFEINFO_kindtypeCHARACTER7:
  4102.       memcpy (array.character7 + offset,
  4103.           ffetarget_text_character7 (constant.character7),
  4104.           ffetarget_length_character7 (constant.character7));
  4105.       break;
  4106. #endif
  4107.  
  4108. #if FFETARGET_okCHARACTER8
  4109.     case FFEINFO_kindtypeCHARACTER8:
  4110.       memcpy (array.character8 + offset,
  4111.           ffetarget_text_character8 (constant.character8),
  4112.           ffetarget_length_character8 (constant.character8));
  4113.       break;
  4114. #endif
  4115.  
  4116.     default:
  4117.       assert ("bad CHARACTER kindtype" == NULL);
  4118.       break;
  4119.     }
  4120.       break;
  4121.  
  4122.     default:
  4123.       assert ("bad basictype" == NULL);
  4124.       break;
  4125.     }
  4126. }
  4127.  
  4128. /* ffebld_constantunion_dump -- Dump a constant
  4129.  
  4130.    See prototype.  */
  4131.  
  4132. void
  4133. ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
  4134.                ffeinfoKindtype kt)
  4135. {
  4136.   switch (bt)
  4137.     {
  4138.     case FFEINFO_basictypeINTEGER:
  4139.       switch (kt)
  4140.     {
  4141. #if FFETARGET_okINTEGER1
  4142.     case FFEINFO_kindtypeINTEGER1:
  4143.       ffetarget_print_integer1 (stdout, u.integer1);
  4144.       break;
  4145. #endif
  4146.  
  4147. #if FFETARGET_okINTEGER2
  4148.     case FFEINFO_kindtypeINTEGER2:
  4149.       ffetarget_print_integer2 (stdout, u.integer2);
  4150.       break;
  4151. #endif
  4152.  
  4153. #if FFETARGET_okINTEGER3
  4154.     case FFEINFO_kindtypeINTEGER3:
  4155.       ffetarget_print_integer3 (stdout, u.integer3);
  4156.       break;
  4157. #endif
  4158.  
  4159. #if FFETARGET_okINTEGER4
  4160.     case FFEINFO_kindtypeINTEGER4:
  4161.       ffetarget_print_integer4 (stdout, u.integer4);
  4162.       break;
  4163. #endif
  4164.  
  4165. #if FFETARGET_okINTEGER5
  4166.     case FFEINFO_kindtypeINTEGER5:
  4167.       ffetarget_print_integer5 (stdout, u.integer5);
  4168.       break;
  4169. #endif
  4170.  
  4171. #if FFETARGET_okINTEGER6
  4172.     case FFEINFO_kindtypeINTEGER6:
  4173.       ffetarget_print_integer6 (stdout, u.integer6);
  4174.       break;
  4175. #endif
  4176.  
  4177. #if FFETARGET_okINTEGER7
  4178.     case FFEINFO_kindtypeINTEGER7:
  4179.       ffetarget_print_integer7 (stdout, u.integer7);
  4180.       break;
  4181. #endif
  4182.  
  4183. #if FFETARGET_okINTEGER8
  4184.     case FFEINFO_kindtypeINTEGER8:
  4185.       ffetarget_print_integer8 (stdout, u.integer8);
  4186.       break;
  4187. #endif
  4188.  
  4189.     default:
  4190.       assert ("bad INTEGER kindtype" == NULL);
  4191.       break;
  4192.     }
  4193.       break;
  4194.  
  4195.     case FFEINFO_basictypeLOGICAL:
  4196.       switch (kt)
  4197.     {
  4198. #if FFETARGET_okLOGICAL1
  4199.     case FFEINFO_kindtypeLOGICAL1:
  4200.       ffetarget_print_logical1 (stdout, u.logical1);
  4201.       break;
  4202. #endif
  4203.  
  4204. #if FFETARGET_okLOGICAL2
  4205.     case FFEINFO_kindtypeLOGICAL2:
  4206.       ffetarget_print_logical2 (stdout, u.logical2);
  4207.       break;
  4208. #endif
  4209.  
  4210. #if FFETARGET_okLOGICAL3
  4211.     case FFEINFO_kindtypeLOGICAL3:
  4212.       ffetarget_print_logical3 (stdout, u.logical3);
  4213.       break;
  4214. #endif
  4215.  
  4216. #if FFETARGET_okLOGICAL4
  4217.     case FFEINFO_kindtypeLOGICAL4:
  4218.       ffetarget_print_logical4 (stdout, u.logical4);
  4219.       break;
  4220. #endif
  4221.  
  4222. #if FFETARGET_okLOGICAL5
  4223.     case FFEINFO_kindtypeLOGICAL5:
  4224.       ffetarget_print_logical5 (stdout, u.logical5);
  4225.       break;
  4226. #endif
  4227.  
  4228. #if FFETARGET_okLOGICAL6
  4229.     case FFEINFO_kindtypeLOGICAL6:
  4230.       ffetarget_print_logical6 (stdout, u.logical6);
  4231.       break;
  4232. #endif
  4233.  
  4234. #if FFETARGET_okLOGICAL7
  4235.     case FFEINFO_kindtypeLOGICAL7:
  4236.       ffetarget_print_logical7 (stdout, u.logical7);
  4237.       break;
  4238. #endif
  4239.  
  4240. #if FFETARGET_okLOGICAL8
  4241.     case FFEINFO_kindtypeLOGICAL8:
  4242.       ffetarget_print_logical8 (stdout, u.logical8);
  4243.       break;
  4244. #endif
  4245.  
  4246.     default:
  4247.       assert ("bad LOGICAL kindtype" == NULL);
  4248.       break;
  4249.     }
  4250.       break;
  4251.  
  4252.     case FFEINFO_basictypeREAL:
  4253.       switch (kt)
  4254.     {
  4255. #if FFETARGET_okREAL1
  4256.     case FFEINFO_kindtypeREAL1:
  4257.       ffetarget_print_real1 (stdout, u.real1);
  4258.       break;
  4259. #endif
  4260.  
  4261. #if FFETARGET_okREAL2
  4262.     case FFEINFO_kindtypeREAL2:
  4263.       ffetarget_print_real2 (stdout, u.real2);
  4264.       break;
  4265. #endif
  4266.  
  4267. #if FFETARGET_okREAL3
  4268.     case FFEINFO_kindtypeREAL3:
  4269.       ffetarget_print_real3 (stdout, u.real3);
  4270.       break;
  4271. #endif
  4272.  
  4273. #if FFETARGET_okREAL4
  4274.     case FFEINFO_kindtypeREAL4:
  4275.       ffetarget_print_real4 (stdout, u.real4);
  4276.       break;
  4277. #endif
  4278.  
  4279. #if FFETARGET_okREAL5
  4280.     case FFEINFO_kindtypeREAL5:
  4281.       ffetarget_print_real5 (stdout, u.real5);
  4282.       break;
  4283. #endif
  4284.  
  4285. #if FFETARGET_okREAL6
  4286.     case FFEINFO_kindtypeREAL6:
  4287.       ffetarget_print_real6 (stdout, u.real6);
  4288.       break;
  4289. #endif
  4290.  
  4291. #if FFETARGET_okREAL7
  4292.     case FFEINFO_kindtypeREAL7:
  4293.       ffetarget_print_real7 (stdout, u.real7);
  4294.       break;
  4295. #endif
  4296.  
  4297. #if FFETARGET_okREAL8
  4298.     case FFEINFO_kindtypeREAL8:
  4299.       ffetarget_print_real8 (stdout, u.real8);
  4300.       break;
  4301. #endif
  4302.  
  4303.     default:
  4304.       assert ("bad REAL kindtype" == NULL);
  4305.       break;
  4306.     }
  4307.       break;
  4308.  
  4309.     case FFEINFO_basictypeCOMPLEX:
  4310.       switch (kt)
  4311.     {
  4312. #if FFETARGET_okCOMPLEX1
  4313.     case FFEINFO_kindtypeREAL1:
  4314.       fprintf (stdout, "(");
  4315.       ffetarget_print_real1 (stdout, u.complex1.real);
  4316.       fprintf (stdout, ",");
  4317.       ffetarget_print_real1 (stdout, u.complex1.imaginary);
  4318.       fprintf (stdout, ")");
  4319.       break;
  4320. #endif
  4321.  
  4322. #if FFETARGET_okCOMPLEX2
  4323.     case FFEINFO_kindtypeREAL2:
  4324.       fprintf (stdout, "(");
  4325.       ffetarget_print_real2 (stdout, u.complex2.real);
  4326.       fprintf (stdout, ",");
  4327.       ffetarget_print_real2 (stdout, u.complex2.imaginary);
  4328.       fprintf (stdout, ")");
  4329.       break;
  4330. #endif
  4331.  
  4332. #if FFETARGET_okCOMPLEX3
  4333.     case FFEINFO_kindtypeREAL3:
  4334.       fprintf (stdout, "(");
  4335.       ffetarget_print_real3 (stdout, u.complex3.real);
  4336.       fprintf (stdout, ",");
  4337.       ffetarget_print_real3 (stdout, u.complex3.imaginary);
  4338.       fprintf (stdout, ")");
  4339.       break;
  4340. #endif
  4341.  
  4342. #if FFETARGET_okCOMPLEX4
  4343.     case FFEINFO_kindtypeREAL4:
  4344.       fprintf (stdout, "(");
  4345.       ffetarget_print_real4 (stdout, u.complex4.real);
  4346.       fprintf (stdout, ",");
  4347.       ffetarget_print_real4 (stdout, u.complex4.imaginary);
  4348.       fprintf (stdout, ")");
  4349.       break;
  4350. #endif
  4351.  
  4352. #if FFETARGET_okCOMPLEX5
  4353.     case FFEINFO_kindtypeREAL5:
  4354.       fprintf (stdout, "(");
  4355.       ffetarget_print_real5 (stdout, u.complex5.real);
  4356.       fprintf (stdout, ",");
  4357.       ffetarget_print_real5 (stdout, u.complex5.imaginary);
  4358.       fprintf (stdout, ")");
  4359.       break;
  4360. #endif
  4361.  
  4362. #if FFETARGET_okCOMPLEX6
  4363.     case FFEINFO_kindtypeREAL6:
  4364.       fprintf (stdout, "(");
  4365.       ffetarget_print_real6 (stdout, u.complex6.real);
  4366.       fprintf (stdout, ",");
  4367.       ffetarget_print_real6 (stdout, u.complex6.imaginary);
  4368.       fprintf (stdout, ")");
  4369.       break;
  4370. #endif
  4371.  
  4372. #if FFETARGET_okCOMPLEX7
  4373.     case FFEINFO_kindtypeREAL7:
  4374.       fprintf (stdout, "(");
  4375.       ffetarget_print_real7 (stdout, u.complex7.real);
  4376.       fprintf (stdout, ",");
  4377.       ffetarget_print_real7 (stdout, u.complex7.imaginary);
  4378.       fprintf (stdout, ")");
  4379.       break;
  4380. #endif
  4381.  
  4382. #if FFETARGET_okCOMPLEX8
  4383.     case FFEINFO_kindtypeREAL8:
  4384.       fprintf (stdout, "(");
  4385.       ffetarget_print_real8 (stdout, u.complex8.real);
  4386.       fprintf (stdout, ",");
  4387.       ffetarget_print_real8 (stdout, u.complex8.imaginary);
  4388.       fprintf (stdout, ")");
  4389.       break;
  4390. #endif
  4391.  
  4392.     default:
  4393.       assert ("bad COMPLEX kindtype" == NULL);
  4394.       break;
  4395.     }
  4396.       break;
  4397.  
  4398.     case FFEINFO_basictypeCHARACTER:
  4399.       switch (kt)
  4400.     {
  4401. #if FFETARGET_okCHARACTER1
  4402.     case FFEINFO_kindtypeCHARACTER1:
  4403.       ffetarget_print_character1 (stdout, u.character1);
  4404.       break;
  4405. #endif
  4406.  
  4407. #if FFETARGET_okCHARACTER2
  4408.     case FFEINFO_kindtypeCHARACTER2:
  4409.       ffetarget_print_character2 (stdout, u.character2);
  4410.       break;
  4411. #endif
  4412.  
  4413. #if FFETARGET_okCHARACTER3
  4414.     case FFEINFO_kindtypeCHARACTER3:
  4415.       ffetarget_print_character3 (stdout, u.character3);
  4416.       break;
  4417. #endif
  4418.  
  4419. #if FFETARGET_okCHARACTER4
  4420.     case FFEINFO_kindtypeCHARACTER4:
  4421.       ffetarget_print_character4 (stdout, u.character4);
  4422.       break;
  4423. #endif
  4424.  
  4425. #if FFETARGET_okCHARACTER5
  4426.     case FFEINFO_kindtypeCHARACTER5:
  4427.       ffetarget_print_character5 (stdout, u.character5);
  4428.       break;
  4429. #endif
  4430.  
  4431. #if FFETARGET_okCHARACTER6
  4432.     case FFEINFO_kindtypeCHARACTER6:
  4433.       ffetarget_print_character6 (stdout, u.character6);
  4434.       break;
  4435. #endif
  4436.  
  4437. #if FFETARGET_okCHARACTER7
  4438.     case FFEINFO_kindtypeCHARACTER7:
  4439.       ffetarget_print_character7 (stdout, u.character7);
  4440.       break;
  4441. #endif
  4442.  
  4443. #if FFETARGET_okCHARACTER8
  4444.     case FFEINFO_kindtypeCHARACTER8:
  4445.       ffetarget_print_character8 (stdout, u.character8);
  4446.       break;
  4447. #endif
  4448.  
  4449.     default:
  4450.       assert ("bad CHARACTER kindtype" == NULL);
  4451.       break;
  4452.     }
  4453.       break;
  4454.  
  4455.     default:
  4456.       assert ("bad basictype" == NULL);
  4457.       break;
  4458.     }
  4459. }
  4460.  
  4461. /* ffebld_dump -- Dump expression tree in concise form
  4462.  
  4463.    ffebld b;
  4464.    ffebld_dump(b);  */
  4465.  
  4466. void
  4467. ffebld_dump (ffebld b)
  4468. {
  4469.   ffeinfoKind k;
  4470.   ffeinfoWhere w;
  4471.  
  4472.   if (b == NULL)
  4473.     {
  4474.       fprintf (stdout, "(null)");
  4475.       return;
  4476.     }
  4477.  
  4478.   switch (ffebld_op (b))
  4479.     {
  4480.     case FFEBLD_opITEM:
  4481.       fputs ("[", stdout);
  4482.       while (b != NULL)
  4483.     {
  4484.       ffebld_dump (ffebld_head (b));
  4485.       if ((b = ffebld_trail (b)) != NULL)
  4486.         fputs (",", stdout);
  4487.     }
  4488.       fputs ("]", stdout);
  4489.       return;
  4490.  
  4491.     case FFEBLD_opSTAR:
  4492.     case FFEBLD_opBOUNDS:
  4493.     case FFEBLD_opREPEAT:
  4494.     case FFEBLD_opLABTER:
  4495.     case FFEBLD_opLABTOK:
  4496.     case FFEBLD_opIMPDO:
  4497.       fputs (ffebld_op_string (ffebld_op (b)), stdout);
  4498.       break;
  4499.  
  4500.     default:
  4501.       if (ffeinfo_size (ffebld_info (b)) != FFETARGET_charactersizeNONE)
  4502.     fprintf (stdout, "%s%d%s%s*%" ffetargetCharacterSize_f "u",
  4503.          ffebld_op_string (ffebld_op (b)),
  4504.          (int) ffeinfo_rank (ffebld_info (b)),
  4505.          ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
  4506.            ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))),
  4507.          ffeinfo_size (ffebld_info (b)));
  4508.       else
  4509.     fprintf (stdout, "%s%d%s%s", ffebld_op_string (ffebld_op (b)),
  4510.          (int) ffeinfo_rank (ffebld_info (b)),
  4511.          ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
  4512.           ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))));
  4513.       if ((k = ffeinfo_kind (ffebld_info (b))) != FFEINFO_kindNONE)
  4514.     fprintf (stdout, "/%s", ffeinfo_kind_string (k));
  4515.       if ((w = ffeinfo_where (ffebld_info (b))) != FFEINFO_whereNONE)
  4516.     fprintf (stdout, "@%s", ffeinfo_where_string (w));
  4517.       break;
  4518.     }
  4519.  
  4520.   switch (ffebld_arity (b))
  4521.     {
  4522.     case 2:
  4523.       fputs ("(", stdout);
  4524.       ffebld_dump (ffebld_left (b));
  4525.       fputs (",", stdout);
  4526.       ffebld_dump (ffebld_right (b));
  4527.       fputs (")", stdout);
  4528.       break;
  4529.  
  4530.     case 1:
  4531.       fputs ("(", stdout);
  4532.       ffebld_dump (ffebld_left (b));
  4533.       fputs (")", stdout);
  4534.       break;
  4535.  
  4536.     default:
  4537.       switch (ffebld_op (b))
  4538.     {
  4539.     case FFEBLD_opCONTER:
  4540.       fprintf (stdout, "<");
  4541.       ffebld_constant_dump (b->u.conter.expr);
  4542.       fprintf (stdout, ">");
  4543.       break;
  4544.  
  4545.     case FFEBLD_opACCTER:
  4546.       fprintf (stdout, "<");
  4547.       ffebld_constantarray_dump (b->u.accter.array,
  4548.                      ffeinfo_basictype (ffebld_info (b)),
  4549.                      ffeinfo_kindtype (ffebld_info (b)),
  4550.               ffebit_size (b->u.accter.bits), b->u.accter.bits);
  4551.       fprintf (stdout, ">");
  4552.       break;
  4553.  
  4554.     case FFEBLD_opARRTER:
  4555.       fprintf (stdout, "<");
  4556.       ffebld_constantarray_dump (b->u.arrter.array,
  4557.                      ffeinfo_basictype (ffebld_info (b)),
  4558.                      ffeinfo_kindtype (ffebld_info (b)),
  4559.                      b->u.arrter.size, NULL);
  4560.       fprintf (stdout, ">");
  4561.       break;
  4562.  
  4563.     case FFEBLD_opLABTER:
  4564.       if (b->u.labter == NULL)
  4565.         fprintf (stdout, "<>");
  4566.       else
  4567.         fprintf (stdout, "<%" ffelabValue_f "u>", ffelab_value (b->u.labter));
  4568.       break;
  4569.  
  4570.     case FFEBLD_opLABTOK:
  4571.       fprintf (stdout, "<%s>", ffelex_token_text (b->u.labtok));
  4572.       break;
  4573.  
  4574.     case FFEBLD_opSYMTER:
  4575.       fprintf (stdout, "<");
  4576.       ffesymbol_dump (b->u.symter.symbol);
  4577.       if ((b->u.symter.generic != FFEINTRIN_genNONE)
  4578.           || (b->u.symter.specific != FFEINTRIN_specNONE))
  4579.         fprintf (stdout, "{%s:%s:%s}",
  4580.              ffeintrin_name_generic (b->u.symter.generic),
  4581.              ffeintrin_name_specific (b->u.symter.specific),
  4582.         ffeintrin_name_implementation (b->u.symter.implementation));
  4583.       if (b->u.symter.do_iter)
  4584.         fprintf (stdout, "{/do-iter}");
  4585.       fprintf (stdout, ">");
  4586.       break;
  4587.  
  4588.     default:
  4589.       break;
  4590.     }
  4591.     }
  4592. }
  4593.  
  4594. /* ffebld_dump_prefix -- Dump the prefix for a constant of a given type
  4595.  
  4596.    ffebld_dump_prefix(stdout,FFEINFO_basictypeINTEGER,
  4597.      FFEINFO_kindtypeINTEGER1);  */
  4598.  
  4599. void
  4600. ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt)
  4601. {
  4602.   switch (bt)
  4603.     {
  4604.     case FFEINFO_basictypeINTEGER:
  4605.       switch (kt)
  4606.     {
  4607. #if FFETARGET_okINTEGER1
  4608.     case FFEINFO_kindtypeINTEGER1:
  4609.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER1) "/");
  4610.       break;
  4611. #endif
  4612.  
  4613. #if FFETARGET_okINTEGER2
  4614.     case FFEINFO_kindtypeINTEGER2:
  4615.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER2) "/");
  4616.       break;
  4617. #endif
  4618.  
  4619. #if FFETARGET_okINTEGER3
  4620.     case FFEINFO_kindtypeINTEGER3:
  4621.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER3) "/");
  4622.       break;
  4623. #endif
  4624.  
  4625. #if FFETARGET_okINTEGER4
  4626.     case FFEINFO_kindtypeINTEGER4:
  4627.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER4) "/");
  4628.       break;
  4629. #endif
  4630.  
  4631. #if FFETARGET_okINTEGER5
  4632.     case FFEINFO_kindtypeINTEGER5:
  4633.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER5) "/");
  4634.       break;
  4635. #endif
  4636.  
  4637. #if FFETARGET_okINTEGER6
  4638.     case FFEINFO_kindtypeINTEGER6:
  4639.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER6) "/");
  4640.       break;
  4641. #endif
  4642.  
  4643. #if FFETARGET_okINTEGER7
  4644.     case FFEINFO_kindtypeINTEGER7:
  4645.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER7) "/");
  4646.       break;
  4647. #endif
  4648.  
  4649. #if FFETARGET_okINTEGER8
  4650.     case FFEINFO_kindtypeINTEGER8:
  4651.       fprintf (out, "I" STRX (FFETARGET_kindINTEGER8) "/");
  4652.       break;
  4653. #endif
  4654.  
  4655.     default:
  4656.       assert ("bad INTEGER kindtype" == NULL);
  4657.       break;
  4658.     }
  4659.       break;
  4660.  
  4661.     case FFEINFO_basictypeLOGICAL:
  4662.       switch (kt)
  4663.     {
  4664. #if FFETARGET_okLOGICAL1
  4665.     case FFEINFO_kindtypeLOGICAL1:
  4666.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL1) "/");
  4667.       break;
  4668. #endif
  4669.  
  4670. #if FFETARGET_okLOGICAL2
  4671.     case FFEINFO_kindtypeLOGICAL2:
  4672.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL2) "/");
  4673.       break;
  4674. #endif
  4675.  
  4676. #if FFETARGET_okLOGICAL3
  4677.     case FFEINFO_kindtypeLOGICAL3:
  4678.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL3) "/");
  4679.       break;
  4680. #endif
  4681.  
  4682. #if FFETARGET_okLOGICAL4
  4683.     case FFEINFO_kindtypeLOGICAL4:
  4684.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL4) "/");
  4685.       break;
  4686. #endif
  4687.  
  4688. #if FFETARGET_okLOGICAL5
  4689.     case FFEINFO_kindtypeLOGICAL5:
  4690.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL5) "/");
  4691.       break;
  4692. #endif
  4693.  
  4694. #if FFETARGET_okLOGICAL6
  4695.     case FFEINFO_kindtypeLOGICAL6:
  4696.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL6) "/");
  4697.       break;
  4698. #endif
  4699.  
  4700. #if FFETARGET_okLOGICAL7
  4701.     case FFEINFO_kindtypeLOGICAL7:
  4702.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL7) "/");
  4703.       break;
  4704. #endif
  4705.  
  4706. #if FFETARGET_okLOGICAL8
  4707.     case FFEINFO_kindtypeLOGICAL8:
  4708.       fprintf (out, "L" STRX (FFETARGET_kindLOGICAL8) "/");
  4709.       break;
  4710. #endif
  4711.  
  4712.     default:
  4713.       assert ("bad LOGICAL kindtype" == NULL);
  4714.       break;
  4715.     }
  4716.       break;
  4717.  
  4718.     case FFEINFO_basictypeREAL:
  4719.       switch (kt)
  4720.     {
  4721. #if FFETARGET_okREAL1
  4722.     case FFEINFO_kindtypeREAL1:
  4723.       fprintf (out, "R" STRX (FFETARGET_kindREAL1) "/");
  4724.       break;
  4725. #endif
  4726.  
  4727. #if FFETARGET_okREAL2
  4728.     case FFEINFO_kindtypeREAL2:
  4729.       fprintf (out, "R" STRX (FFETARGET_kindREAL2) "/");
  4730.       break;
  4731. #endif
  4732.  
  4733. #if FFETARGET_okREAL3
  4734.     case FFEINFO_kindtypeREAL3:
  4735.       fprintf (out, "R" STRX (FFETARGET_kindREAL3) "/");
  4736.       break;
  4737. #endif
  4738.  
  4739. #if FFETARGET_okREAL4
  4740.     case FFEINFO_kindtypeREAL4:
  4741.       fprintf (out, "R" STRX (FFETARGET_kindREAL4) "/");
  4742.       break;
  4743. #endif
  4744.  
  4745. #if FFETARGET_okREAL5
  4746.     case FFEINFO_kindtypeREAL5:
  4747.       fprintf (out, "R" STRX (FFETARGET_kindREAL5) "/");
  4748.       break;
  4749. #endif
  4750.  
  4751. #if FFETARGET_okREAL6
  4752.     case FFEINFO_kindtypeREAL6:
  4753.       fprintf (out, "R" STRX (FFETARGET_kindREAL6) "/");
  4754.       break;
  4755. #endif
  4756.  
  4757. #if FFETARGET_okREAL7
  4758.     case FFEINFO_kindtypeREAL7:
  4759.       fprintf (out, "R" STRX (FFETARGET_kindREAL7) "/");
  4760.       break;
  4761. #endif
  4762.  
  4763. #if FFETARGET_okREAL8
  4764.     case FFEINFO_kindtypeREAL8:
  4765.       fprintf (out, "R" STRX (FFETARGET_kindREAL8) "/");
  4766.       break;
  4767. #endif
  4768.  
  4769.     default:
  4770.       assert ("bad REAL kindtype" == NULL);
  4771.       break;
  4772.     }
  4773.       break;
  4774.  
  4775.     case FFEINFO_basictypeCOMPLEX:
  4776.       switch (kt)
  4777.     {
  4778. #if FFETARGET_okCOMPLEX1
  4779.     case FFEINFO_kindtypeREAL1:
  4780.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX1) "/");
  4781.       break;
  4782. #endif
  4783.  
  4784. #if FFETARGET_okCOMPLEX2
  4785.     case FFEINFO_kindtypeREAL2:
  4786.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX2) "/");
  4787.       break;
  4788. #endif
  4789.  
  4790. #if FFETARGET_okCOMPLEX3
  4791.     case FFEINFO_kindtypeREAL3:
  4792.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX3) "/");
  4793.       break;
  4794. #endif
  4795.  
  4796. #if FFETARGET_okCOMPLEX4
  4797.     case FFEINFO_kindtypeREAL4:
  4798.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX4) "/");
  4799.       break;
  4800. #endif
  4801.  
  4802. #if FFETARGET_okCOMPLEX5
  4803.     case FFEINFO_kindtypeREAL5:
  4804.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX5) "/");
  4805.       break;
  4806. #endif
  4807.  
  4808. #if FFETARGET_okCOMPLEX6
  4809.     case FFEINFO_kindtypeREAL6:
  4810.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX6) "/");
  4811.       break;
  4812. #endif
  4813.  
  4814. #if FFETARGET_okCOMPLEX7
  4815.     case FFEINFO_kindtypeREAL7:
  4816.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX7) "/");
  4817.       break;
  4818. #endif
  4819.  
  4820. #if FFETARGET_okCOMPLEX8
  4821.     case FFEINFO_kindtypeREAL8:
  4822.       fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX8) "/");
  4823.       break;
  4824. #endif
  4825.  
  4826.     default:
  4827.       assert ("bad COMPLEX kindtype" == NULL);
  4828.       break;
  4829.     }
  4830.       break;
  4831.  
  4832.     case FFEINFO_basictypeCHARACTER:
  4833.       switch (kt)
  4834.     {
  4835. #if FFETARGET_okCHARACTER1
  4836.     case FFEINFO_kindtypeCHARACTER1:
  4837.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER1) "/");
  4838.       break;
  4839. #endif
  4840.  
  4841. #if FFETARGET_okCHARACTER2
  4842.     case FFEINFO_kindtypeCHARACTER2:
  4843.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER2) "/");
  4844.       break;
  4845. #endif
  4846.  
  4847. #if FFETARGET_okCHARACTER3
  4848.     case FFEINFO_kindtypeCHARACTER3:
  4849.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER3) "/");
  4850.       break;
  4851. #endif
  4852.  
  4853. #if FFETARGET_okCHARACTER4
  4854.     case FFEINFO_kindtypeCHARACTER4:
  4855.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER4) "/");
  4856.       break;
  4857. #endif
  4858.  
  4859. #if FFETARGET_okCHARACTER5
  4860.     case FFEINFO_kindtypeCHARACTER5:
  4861.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER5) "/");
  4862.       break;
  4863. #endif
  4864.  
  4865. #if FFETARGET_okCHARACTER6
  4866.     case FFEINFO_kindtypeCHARACTER6:
  4867.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER6) "/");
  4868.       break;
  4869. #endif
  4870.  
  4871. #if FFETARGET_okCHARACTER7
  4872.     case FFEINFO_kindtypeCHARACTER7:
  4873.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER7) "/");
  4874.       break;
  4875. #endif
  4876.  
  4877. #if FFETARGET_okCHARACTER8
  4878.     case FFEINFO_kindtypeCHARACTER8:
  4879.       fprintf (out, "A" STRX (FFETARGET_kindCHARACTER8) "/");
  4880.       break;
  4881. #endif
  4882.  
  4883.     default:
  4884.       assert ("bad CHARACTER kindtype" == NULL);
  4885.       break;
  4886.     }
  4887.       break;
  4888.  
  4889.     default:
  4890.       assert ("bad basictype" == NULL);
  4891.       fprintf (out, "?/?");
  4892.       break;
  4893.     }
  4894. }
  4895.  
  4896. /* ffebld_init_0 -- Initialize the module
  4897.  
  4898.    ffebld_init_0();  */
  4899.  
  4900. void
  4901. ffebld_init_0 ()
  4902. {
  4903.   assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_));
  4904.   assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_));
  4905. }
  4906.  
  4907. /* ffebld_init_1 -- Initialize the module for a file
  4908.  
  4909.    ffebld_init_1();  */
  4910.  
  4911. void
  4912. ffebld_init_1 ()
  4913. {
  4914. #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
  4915.   int i;
  4916.  
  4917. #if FFETARGET_okCHARACTER1
  4918.   ffebld_constant_character1_ = NULL;
  4919. #endif
  4920. #if FFETARGET_okCHARACTER2
  4921.   ffebld_constant_character2_ = NULL;
  4922. #endif
  4923. #if FFETARGET_okCHARACTER3
  4924.   ffebld_constant_character3_ = NULL;
  4925. #endif
  4926. #if FFETARGET_okCHARACTER4
  4927.   ffebld_constant_character4_ = NULL;
  4928. #endif
  4929. #if FFETARGET_okCHARACTER5
  4930.   ffebld_constant_character5_ = NULL;
  4931. #endif
  4932. #if FFETARGET_okCHARACTER6
  4933.   ffebld_constant_character6_ = NULL;
  4934. #endif
  4935. #if FFETARGET_okCHARACTER7
  4936.   ffebld_constant_character7_ = NULL;
  4937. #endif
  4938. #if FFETARGET_okCHARACTER8
  4939.   ffebld_constant_character8_ = NULL;
  4940. #endif
  4941. #if FFETARGET_okCOMPLEX1
  4942.   ffebld_constant_complex1_ = NULL;
  4943. #endif
  4944. #if FFETARGET_okCOMPLEX2
  4945.   ffebld_constant_complex2_ = NULL;
  4946. #endif
  4947. #if FFETARGET_okCOMPLEX3
  4948.   ffebld_constant_complex3_ = NULL;
  4949. #endif
  4950. #if FFETARGET_okCOMPLEX4
  4951.   ffebld_constant_complex4_ = NULL;
  4952. #endif
  4953. #if FFETARGET_okCOMPLEX5
  4954.   ffebld_constant_complex5_ = NULL;
  4955. #endif
  4956. #if FFETARGET_okCOMPLEX6
  4957.   ffebld_constant_complex6_ = NULL;
  4958. #endif
  4959. #if FFETARGET_okCOMPLEX7
  4960.   ffebld_constant_complex7_ = NULL;
  4961. #endif
  4962. #if FFETARGET_okCOMPLEX8
  4963.   ffebld_constant_complex8_ = NULL;
  4964. #endif
  4965. #if FFETARGET_okINTEGER1
  4966.   ffebld_constant_integer1_ = NULL;
  4967. #endif
  4968. #if FFETARGET_okINTEGER2
  4969.   ffebld_constant_integer2_ = NULL;
  4970. #endif
  4971. #if FFETARGET_okINTEGER3
  4972.   ffebld_constant_integer3_ = NULL;
  4973. #endif
  4974. #if FFETARGET_okINTEGER4
  4975.   ffebld_constant_integer4_ = NULL;
  4976. #endif
  4977. #if FFETARGET_okINTEGER5
  4978.   ffebld_constant_integer5_ = NULL;
  4979. #endif
  4980. #if FFETARGET_okINTEGER6
  4981.   ffebld_constant_integer6_ = NULL;
  4982. #endif
  4983. #if FFETARGET_okINTEGER7
  4984.   ffebld_constant_integer7_ = NULL;
  4985. #endif
  4986. #if FFETARGET_okINTEGER8
  4987.   ffebld_constant_integer8_ = NULL;
  4988. #endif
  4989. #if FFETARGET_okLOGICAL1
  4990.   ffebld_constant_logical1_ = NULL;
  4991. #endif
  4992. #if FFETARGET_okLOGICAL2
  4993.   ffebld_constant_logical2_ = NULL;
  4994. #endif
  4995. #if FFETARGET_okLOGICAL3
  4996.   ffebld_constant_logical3_ = NULL;
  4997. #endif
  4998. #if FFETARGET_okLOGICAL4
  4999.   ffebld_constant_logical4_ = NULL;
  5000. #endif
  5001. #if FFETARGET_okLOGICAL5
  5002.   ffebld_constant_logical5_ = NULL;
  5003. #endif
  5004. #if FFETARGET_okLOGICAL6
  5005.   ffebld_constant_logical6_ = NULL;
  5006. #endif
  5007. #if FFETARGET_okLOGICAL7
  5008.   ffebld_constant_logical7_ = NULL;
  5009. #endif
  5010. #if FFETARGET_okLOGICAL8
  5011.   ffebld_constant_logical8_ = NULL;
  5012. #endif
  5013. #if FFETARGET_okREAL1
  5014.   ffebld_constant_real1_ = NULL;
  5015. #endif
  5016. #if FFETARGET_okREAL2
  5017.   ffebld_constant_real2_ = NULL;
  5018. #endif
  5019. #if FFETARGET_okREAL3
  5020.   ffebld_constant_real3_ = NULL;
  5021. #endif
  5022. #if FFETARGET_okREAL4
  5023.   ffebld_constant_real4_ = NULL;
  5024. #endif
  5025. #if FFETARGET_okREAL5
  5026.   ffebld_constant_real5_ = NULL;
  5027. #endif
  5028. #if FFETARGET_okREAL6
  5029.   ffebld_constant_real6_ = NULL;
  5030. #endif
  5031. #if FFETARGET_okREAL7
  5032.   ffebld_constant_real7_ = NULL;
  5033. #endif
  5034. #if FFETARGET_okREAL8
  5035.   ffebld_constant_real8_ = NULL;
  5036. #endif
  5037.   ffebld_constant_hollerith_ = NULL;
  5038.   for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
  5039.     ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
  5040. #endif
  5041. }
  5042.  
  5043. /* ffebld_init_2 -- Initialize the module
  5044.  
  5045.    ffebld_init_2();  */
  5046.  
  5047. void
  5048. ffebld_init_2 ()
  5049. {
  5050. #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
  5051.   int i;
  5052. #endif
  5053.  
  5054.   ffebld_pool_stack_.next = NULL;
  5055.   ffebld_pool_stack_.pool = ffe_pool_program_unit ();
  5056. #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
  5057. #if FFETARGET_okCHARACTER1
  5058.   ffebld_constant_character1_ = NULL;
  5059. #endif
  5060. #if FFETARGET_okCHARACTER2
  5061.   ffebld_constant_character2_ = NULL;
  5062. #endif
  5063. #if FFETARGET_okCHARACTER3
  5064.   ffebld_constant_character3_ = NULL;
  5065. #endif
  5066. #if FFETARGET_okCHARACTER4
  5067.   ffebld_constant_character4_ = NULL;
  5068. #endif
  5069. #if FFETARGET_okCHARACTER5
  5070.   ffebld_constant_character5_ = NULL;
  5071. #endif
  5072. #if FFETARGET_okCHARACTER6
  5073.   ffebld_constant_character6_ = NULL;
  5074. #endif
  5075. #if FFETARGET_okCHARACTER7
  5076.   ffebld_constant_character7_ = NULL;
  5077. #endif
  5078. #if FFETARGET_okCHARACTER8
  5079.   ffebld_constant_character8_ = NULL;
  5080. #endif
  5081. #if FFETARGET_okCOMPLEX1
  5082.   ffebld_constant_complex1_ = NULL;
  5083. #endif
  5084. #if FFETARGET_okCOMPLEX2
  5085.   ffebld_constant_complex2_ = NULL;
  5086. #endif
  5087. #if FFETARGET_okCOMPLEX3
  5088.   ffebld_constant_complex3_ = NULL;
  5089. #endif
  5090. #if FFETARGET_okCOMPLEX4
  5091.   ffebld_constant_complex4_ = NULL;
  5092. #endif
  5093. #if FFETARGET_okCOMPLEX5
  5094.   ffebld_constant_complex5_ = NULL;
  5095. #endif
  5096. #if FFETARGET_okCOMPLEX6
  5097.   ffebld_constant_complex6_ = NULL;
  5098. #endif
  5099. #if FFETARGET_okCOMPLEX7
  5100.   ffebld_constant_complex7_ = NULL;
  5101. #endif
  5102. #if FFETARGET_okCOMPLEX8
  5103.   ffebld_constant_complex8_ = NULL;
  5104. #endif
  5105. #if FFETARGET_okINTEGER1
  5106.   ffebld_constant_integer1_ = NULL;
  5107. #endif
  5108. #if FFETARGET_okINTEGER2
  5109.   ffebld_constant_integer2_ = NULL;
  5110. #endif
  5111. #if FFETARGET_okINTEGER3
  5112.   ffebld_constant_integer3_ = NULL;
  5113. #endif
  5114. #if FFETARGET_okINTEGER4
  5115.   ffebld_constant_integer4_ = NULL;
  5116. #endif
  5117. #if FFETARGET_okINTEGER5
  5118.   ffebld_constant_integer5_ = NULL;
  5119. #endif
  5120. #if FFETARGET_okINTEGER6
  5121.   ffebld_constant_integer6_ = NULL;
  5122. #endif
  5123. #if FFETARGET_okINTEGER7
  5124.   ffebld_constant_integer7_ = NULL;
  5125. #endif
  5126. #if FFETARGET_okINTEGER8
  5127.   ffebld_constant_integer8_ = NULL;
  5128. #endif
  5129. #if FFETARGET_okLOGICAL1
  5130.   ffebld_constant_logical1_ = NULL;
  5131. #endif
  5132. #if FFETARGET_okLOGICAL2
  5133.   ffebld_constant_logical2_ = NULL;
  5134. #endif
  5135. #if FFETARGET_okLOGICAL3
  5136.   ffebld_constant_logical3_ = NULL;
  5137. #endif
  5138. #if FFETARGET_okLOGICAL4
  5139.   ffebld_constant_logical4_ = NULL;
  5140. #endif
  5141. #if FFETARGET_okLOGICAL5
  5142.   ffebld_constant_logical5_ = NULL;
  5143. #endif
  5144. #if FFETARGET_okLOGICAL6
  5145.   ffebld_constant_logical6_ = NULL;
  5146. #endif
  5147. #if FFETARGET_okLOGICAL7
  5148.   ffebld_constant_logical7_ = NULL;
  5149. #endif
  5150. #if FFETARGET_okLOGICAL8
  5151.   ffebld_constant_logical8_ = NULL;
  5152. #endif
  5153. #if FFETARGET_okREAL1
  5154.   ffebld_constant_real1_ = NULL;
  5155. #endif
  5156. #if FFETARGET_okREAL2
  5157.   ffebld_constant_real2_ = NULL;
  5158. #endif
  5159. #if FFETARGET_okREAL3
  5160.   ffebld_constant_real3_ = NULL;
  5161. #endif
  5162. #if FFETARGET_okREAL4
  5163.   ffebld_constant_real4_ = NULL;
  5164. #endif
  5165. #if FFETARGET_okREAL5
  5166.   ffebld_constant_real5_ = NULL;
  5167. #endif
  5168. #if FFETARGET_okREAL6
  5169.   ffebld_constant_real6_ = NULL;
  5170. #endif
  5171. #if FFETARGET_okREAL7
  5172.   ffebld_constant_real7_ = NULL;
  5173. #endif
  5174. #if FFETARGET_okREAL8
  5175.   ffebld_constant_real8_ = NULL;
  5176. #endif
  5177.   ffebld_constant_hollerith_ = NULL;
  5178.   for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
  5179.     ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
  5180. #endif
  5181. }
  5182.  
  5183. /* ffebld_list_length -- Return # of opITEMs in list
  5184.  
  5185.    ffebld list;     // Must be NULL or opITEM
  5186.    ffebldListLength length;
  5187.    length = ffebld_list_length(list);
  5188.  
  5189.    Returns 0 if list is NULL, 1 if it's ffebld_trail is NULL, and so on.  */
  5190.  
  5191. ffebldListLength
  5192. ffebld_list_length (ffebld list)
  5193. {
  5194.   ffebldListLength length;
  5195.  
  5196.   for (length = 0; list != NULL; ++length, list = ffebld_trail (list))
  5197.     ;
  5198.  
  5199.   return length;
  5200. }
  5201.  
  5202. /* ffebld_new_accter -- Create an ffebld object that is an array
  5203.  
  5204.    ffebld x;
  5205.    ffebldConstantArray a;
  5206.    ffebit b;
  5207.    x = ffebld_new_accter(a,b);    */
  5208.  
  5209. ffebld
  5210. ffebld_new_accter (ffebldConstantArray a, ffebit b)
  5211. {
  5212.   ffebld x;
  5213.  
  5214.   x = ffebld_new ();
  5215. #if FFEBLD_BLANK_
  5216.   *x = ffebld_blank_;
  5217. #endif
  5218.   x->op = FFEBLD_opACCTER;
  5219.   x->u.accter.array = a;
  5220.   x->u.accter.bits = b;
  5221.   return x;
  5222. }
  5223.  
  5224. /* ffebld_new_arrter -- Create an ffebld object that is an array
  5225.  
  5226.    ffebld x;
  5227.    ffebldConstantArray a;
  5228.    ffetargetOffset size;
  5229.    x = ffebld_new_arrter(a,size);  */
  5230.  
  5231. ffebld
  5232. ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
  5233. {
  5234.   ffebld x;
  5235.  
  5236.   x = ffebld_new ();
  5237. #if FFEBLD_BLANK_
  5238.   *x = ffebld_blank_;
  5239. #endif
  5240.   x->op = FFEBLD_opARRTER;
  5241.   x->u.arrter.array = a;
  5242.   x->u.arrter.size = size;
  5243.   return x;
  5244. }
  5245.  
  5246. /* ffebld_new_conter_with_orig -- Create an ffebld object that is a constant
  5247.  
  5248.    ffebld x;
  5249.    ffebldConstant c;
  5250.    x = ffebld_new_conter_with_orig(c,NULL);  */
  5251.  
  5252. ffebld
  5253. ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
  5254. {
  5255.   ffebld x;
  5256.  
  5257.   x = ffebld_new ();
  5258. #if FFEBLD_BLANK_
  5259.   *x = ffebld_blank_;
  5260. #endif
  5261.   x->op = FFEBLD_opCONTER;
  5262.   x->u.conter.expr = c;
  5263.   x->u.conter.orig = o;
  5264.   return x;
  5265. }
  5266.  
  5267. /* ffebld_new_item -- Create an ffebld item object
  5268.  
  5269.    ffebld x,y,z;
  5270.    x = ffebld_new_item(y,z);  */
  5271.  
  5272. ffebld
  5273. ffebld_new_item (ffebld head, ffebld trail)
  5274. {
  5275.   ffebld x;
  5276.  
  5277.   x = ffebld_new ();
  5278. #if FFEBLD_BLANK_
  5279.   *x = ffebld_blank_;
  5280. #endif
  5281.   x->op = FFEBLD_opITEM;
  5282.   x->u.item.head = head;
  5283.   x->u.item.trail = trail;
  5284.   return x;
  5285. }
  5286.  
  5287. /* ffebld_new_labter -- Create an ffebld object that is a label
  5288.  
  5289.    ffebld x;
  5290.    ffelab l;
  5291.    x = ffebld_new_labter(c);  */
  5292.  
  5293. ffebld
  5294. ffebld_new_labter (ffelab l)
  5295. {
  5296.   ffebld x;
  5297.  
  5298.   x = ffebld_new ();
  5299. #if FFEBLD_BLANK_
  5300.   *x = ffebld_blank_;
  5301. #endif
  5302.   x->op = FFEBLD_opLABTER;
  5303.   x->u.labter = l;
  5304.   return x;
  5305. }
  5306.  
  5307. /* ffebld_new_labtok -- Create object that is a label's NUMBER token
  5308.  
  5309.    ffebld x;
  5310.    ffelexToken t;
  5311.    x = ffebld_new_labter(c);
  5312.  
  5313.    Like the other ffebld_new_ functions, the
  5314.    supplied argument is stored exactly as is: ffelex_token_use is NOT
  5315.    called, so the token is "consumed", if one is indeed supplied (it may
  5316.    be NULL).  */
  5317.  
  5318. ffebld
  5319. ffebld_new_labtok (ffelexToken t)
  5320. {
  5321.   ffebld x;
  5322.  
  5323.   x = ffebld_new ();
  5324. #if FFEBLD_BLANK_
  5325.   *x = ffebld_blank_;
  5326. #endif
  5327.   x->op = FFEBLD_opLABTOK;
  5328.   x->u.labtok = t;
  5329.   return x;
  5330. }
  5331.  
  5332. /* ffebld_new_none -- Create an ffebld object with no arguments
  5333.  
  5334.    ffebld x;
  5335.    x = ffebld_new_none(FFEBLD_opWHATEVER);  */
  5336.  
  5337. ffebld
  5338. ffebld_new_none (ffebldOp o)
  5339. {
  5340.   ffebld x;
  5341.  
  5342.   x = ffebld_new ();
  5343. #if FFEBLD_BLANK_
  5344.   *x = ffebld_blank_;
  5345. #endif
  5346.   x->op = o;
  5347.   return x;
  5348. }
  5349.  
  5350. /* ffebld_new_one -- Create an ffebld object with one argument
  5351.  
  5352.    ffebld x,y;
  5353.    x = ffebld_new_one(FFEBLD_opWHATEVER,y);  */
  5354.  
  5355. ffebld
  5356. ffebld_new_one (ffebldOp o, ffebld left)
  5357. {
  5358.   ffebld x;
  5359.  
  5360.   x = ffebld_new ();
  5361. #if FFEBLD_BLANK_
  5362.   *x = ffebld_blank_;
  5363. #endif
  5364.   x->op = o;
  5365.   x->u.nonter.left = left;
  5366.   return x;
  5367. }
  5368.  
  5369. /* ffebld_new_symter -- Create an ffebld object that is a symbol
  5370.  
  5371.    ffebld x;
  5372.    ffesymbol s;
  5373.    ffeintrinGen gen;    // Generic intrinsic id, if any
  5374.    ffeintrinSpec spec;    // Specific intrinsic id, if any
  5375.    ffeintrinImp imp;    // Implementation intrinsic id, if any
  5376.    x = ffebld_new_symter (s, gen, spec, imp);  */
  5377.  
  5378. ffebld
  5379. ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
  5380.            ffeintrinImp imp)
  5381. {
  5382.   ffebld x;
  5383.  
  5384.   x = ffebld_new ();
  5385. #if FFEBLD_BLANK_
  5386.   *x = ffebld_blank_;
  5387. #endif
  5388.   x->op = FFEBLD_opSYMTER;
  5389.   x->u.symter.symbol = s;
  5390.   x->u.symter.generic = gen;
  5391.   x->u.symter.specific = spec;
  5392.   x->u.symter.implementation = imp;
  5393.   x->u.symter.do_iter = FALSE;
  5394.   return x;
  5395. }
  5396.  
  5397. /* ffebld_new_two -- Create an ffebld object with two arguments
  5398.  
  5399.    ffebld x,y,z;
  5400.    x = ffebld_new_two(FFEBLD_opWHATEVER,y,z);  */
  5401.  
  5402. ffebld
  5403. ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
  5404. {
  5405.   ffebld x;
  5406.  
  5407.   x = ffebld_new ();
  5408. #if FFEBLD_BLANK_
  5409.   *x = ffebld_blank_;
  5410. #endif
  5411.   x->op = o;
  5412.   x->u.nonter.left = left;
  5413.   x->u.nonter.right = right;
  5414.   return x;
  5415. }
  5416.  
  5417. /* ffebld_pool_pop -- Pop ffebld's pool stack
  5418.  
  5419.    ffebld_pool_pop();  */
  5420.  
  5421. void
  5422. ffebld_pool_pop ()
  5423. {
  5424.   ffebldPoolstack_ ps;
  5425.  
  5426.   assert (ffebld_pool_stack_.next != NULL);
  5427.   ps = ffebld_pool_stack_.next;
  5428.   ffebld_pool_stack_.next = ps->next;
  5429.   ffebld_pool_stack_.pool = ps->pool;
  5430.   malloc_kill_ks (malloc_pool_image (), ps, sizeof (*ps));
  5431. }
  5432.  
  5433. /* ffebld_pool_push -- Push ffebld's pool stack
  5434.  
  5435.    ffebld_pool_push();    */
  5436.  
  5437. void
  5438. ffebld_pool_push (mallocPool pool)
  5439. {
  5440.   ffebldPoolstack_ ps;
  5441.  
  5442.   ps = malloc_new_ks (malloc_pool_image (), "Pool stack", sizeof (*ps));
  5443.   ps->next = ffebld_pool_stack_.next;
  5444.   ps->pool = ffebld_pool_stack_.pool;
  5445.   ffebld_pool_stack_.next = ps;
  5446.   ffebld_pool_stack_.pool = pool;
  5447. }
  5448.  
  5449. /* ffebld_op_string -- Return short string describing op
  5450.  
  5451.    ffebldOp o;
  5452.    ffebld_op_string(o);
  5453.  
  5454.    Returns a short string (uppercase) containing the name of the op.  */
  5455.  
  5456. char *
  5457. ffebld_op_string (ffebldOp o)
  5458. {
  5459.   if (o >= ARRAY_SIZE (ffebld_op_string_))
  5460.     return "?\?\?";
  5461.   return ffebld_op_string_[o];
  5462. }
  5463.  
  5464. /* ffebld_size_max -- Return maximum possible size of CHARACTER-type expr
  5465.  
  5466.    ffetargetCharacterSize sz;
  5467.    ffebld b;
  5468.    sz = ffebld_size_max (b);
  5469.  
  5470.    Like ffebld_size_known, but if that would return NONE and the expression
  5471.    is opSUBSTR, opCONVERT, opPAREN, or opCONCATENATE, returns ffebld_size_max
  5472.    of the subexpression(s).  */
  5473.  
  5474. ffetargetCharacterSize
  5475. ffebld_size_max (ffebld b)
  5476. {
  5477.   ffetargetCharacterSize sz;
  5478.  
  5479. recurse:            /* :::::::::::::::::::: */
  5480.  
  5481.   sz = ffebld_size_known (b);
  5482.  
  5483.   if (sz != FFETARGET_charactersizeNONE)
  5484.     return sz;
  5485.  
  5486.   switch (ffebld_op (b))
  5487.     {
  5488.     case FFEBLD_opSUBSTR:
  5489.     case FFEBLD_opCONVERT:
  5490.     case FFEBLD_opPAREN:
  5491.       b = ffebld_left (b);
  5492.       goto recurse;        /* :::::::::::::::::::: */
  5493.  
  5494.     case FFEBLD_opCONCATENATE:
  5495.       sz = ffebld_size_max (ffebld_left (b))
  5496.     + ffebld_size_max (ffebld_right (b));
  5497.       return sz;
  5498.  
  5499.     default:
  5500.       return sz;
  5501.     }
  5502. }
  5503.