PageRenderTime 498ms CodeModel.GetById 26ms app.highlight 418ms RepoModel.GetById 0ms app.codeStats 3ms

/gcc-2.95.2/gcc/f/expr.c

https://bitbucket.org/monaka/brightv-buildenv
C | 17141 lines | 13729 code | 2051 blank | 1361 comment | 2451 complexity | 37669c40c33a4929d1f2149bbd001c83 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0
    1/* expr.c -- Implementation File (module.c template V1.0)
    2   Copyright (C) 1995-1998 Free Software Foundation, Inc.
    3   Contributed by James Craig Burley.
    4
    5This file is part of GNU Fortran.
    6
    7GNU Fortran is free software; you can redistribute it and/or modify
    8it under the terms of the GNU General Public License as published by
    9the Free Software Foundation; either version 2, or (at your option)
   10any later version.
   11
   12GNU Fortran is distributed in the hope that it will be useful,
   13but WITHOUT ANY WARRANTY; without even the implied warranty of
   14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15GNU General Public License for more details.
   16
   17You should have received a copy of the GNU General Public License
   18along with GNU Fortran; see the file COPYING.  If not, write to
   19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
   2002111-1307, USA.
   21
   22   Related Modules:
   23      None.
   24
   25   Description:
   26      Handles syntactic and semantic analysis of Fortran expressions.
   27
   28   Modifications:
   29*/
   30
   31/* Include files. */
   32
   33#include "proj.h"
   34#include "expr.h"
   35#include "bad.h"
   36#include "bld.h"
   37#include "com.h"
   38#include "global.h"
   39#include "implic.h"
   40#include "intrin.h"
   41#include "info.h"
   42#include "lex.h"
   43#include "malloc.h"
   44#include "src.h"
   45#include "st.h"
   46#include "symbol.h"
   47#include "str.h"
   48#include "target.h"
   49#include "where.h"
   50
   51/* Externals defined here. */
   52
   53
   54/* Simple definitions and enumerations. */
   55
   56typedef enum
   57  {
   58    FFEEXPR_exprtypeUNKNOWN_,
   59    FFEEXPR_exprtypeOPERAND_,
   60    FFEEXPR_exprtypeUNARY_,
   61    FFEEXPR_exprtypeBINARY_,
   62    FFEEXPR_exprtype_
   63  } ffeexprExprtype_;
   64
   65typedef enum
   66  {
   67    FFEEXPR_operatorPOWER_,
   68    FFEEXPR_operatorMULTIPLY_,
   69    FFEEXPR_operatorDIVIDE_,
   70    FFEEXPR_operatorADD_,
   71    FFEEXPR_operatorSUBTRACT_,
   72    FFEEXPR_operatorCONCATENATE_,
   73    FFEEXPR_operatorLT_,
   74    FFEEXPR_operatorLE_,
   75    FFEEXPR_operatorEQ_,
   76    FFEEXPR_operatorNE_,
   77    FFEEXPR_operatorGT_,
   78    FFEEXPR_operatorGE_,
   79    FFEEXPR_operatorNOT_,
   80    FFEEXPR_operatorAND_,
   81    FFEEXPR_operatorOR_,
   82    FFEEXPR_operatorXOR_,
   83    FFEEXPR_operatorEQV_,
   84    FFEEXPR_operatorNEQV_,
   85    FFEEXPR_operator_
   86  } ffeexprOperator_;
   87
   88typedef enum
   89  {
   90    FFEEXPR_operatorprecedenceHIGHEST_ = 1,
   91    FFEEXPR_operatorprecedencePOWER_ = 1,
   92    FFEEXPR_operatorprecedenceMULTIPLY_ = 2,
   93    FFEEXPR_operatorprecedenceDIVIDE_ = 2,
   94    FFEEXPR_operatorprecedenceADD_ = 3,
   95    FFEEXPR_operatorprecedenceSUBTRACT_ = 3,
   96    FFEEXPR_operatorprecedenceLOWARITH_ = 3,
   97    FFEEXPR_operatorprecedenceCONCATENATE_ = 3,
   98    FFEEXPR_operatorprecedenceLT_ = 4,
   99    FFEEXPR_operatorprecedenceLE_ = 4,
  100    FFEEXPR_operatorprecedenceEQ_ = 4,
  101    FFEEXPR_operatorprecedenceNE_ = 4,
  102    FFEEXPR_operatorprecedenceGT_ = 4,
  103    FFEEXPR_operatorprecedenceGE_ = 4,
  104    FFEEXPR_operatorprecedenceNOT_ = 5,
  105    FFEEXPR_operatorprecedenceAND_ = 6,
  106    FFEEXPR_operatorprecedenceOR_ = 7,
  107    FFEEXPR_operatorprecedenceXOR_ = 8,
  108    FFEEXPR_operatorprecedenceEQV_ = 8,
  109    FFEEXPR_operatorprecedenceNEQV_ = 8,
  110    FFEEXPR_operatorprecedenceLOWEST_ = 8,
  111    FFEEXPR_operatorprecedence_
  112  } ffeexprOperatorPrecedence_;
  113
  114#define FFEEXPR_operatorassociativityL2R_ TRUE
  115#define FFEEXPR_operatorassociativityR2L_ FALSE
  116#define FFEEXPR_operatorassociativityPOWER_ FFEEXPR_operatorassociativityR2L_
  117#define FFEEXPR_operatorassociativityMULTIPLY_ FFEEXPR_operatorassociativityL2R_
  118#define FFEEXPR_operatorassociativityDIVIDE_ FFEEXPR_operatorassociativityL2R_
  119#define FFEEXPR_operatorassociativityADD_ FFEEXPR_operatorassociativityL2R_
  120#define FFEEXPR_operatorassociativitySUBTRACT_ FFEEXPR_operatorassociativityL2R_
  121#define FFEEXPR_operatorassociativityCONCATENATE_ FFEEXPR_operatorassociativityL2R_
  122#define FFEEXPR_operatorassociativityLT_ FFEEXPR_operatorassociativityL2R_
  123#define FFEEXPR_operatorassociativityLE_ FFEEXPR_operatorassociativityL2R_
  124#define FFEEXPR_operatorassociativityEQ_ FFEEXPR_operatorassociativityL2R_
  125#define FFEEXPR_operatorassociativityNE_ FFEEXPR_operatorassociativityL2R_
  126#define FFEEXPR_operatorassociativityGT_ FFEEXPR_operatorassociativityL2R_
  127#define FFEEXPR_operatorassociativityGE_ FFEEXPR_operatorassociativityL2R_
  128#define FFEEXPR_operatorassociativityNOT_ FFEEXPR_operatorassociativityL2R_
  129#define FFEEXPR_operatorassociativityAND_ FFEEXPR_operatorassociativityL2R_
  130#define FFEEXPR_operatorassociativityOR_ FFEEXPR_operatorassociativityL2R_
  131#define FFEEXPR_operatorassociativityXOR_ FFEEXPR_operatorassociativityL2R_
  132#define FFEEXPR_operatorassociativityEQV_ FFEEXPR_operatorassociativityL2R_
  133#define FFEEXPR_operatorassociativityNEQV_ FFEEXPR_operatorassociativityL2R_
  134
  135typedef enum
  136  {
  137    FFEEXPR_parentypeFUNCTION_,
  138    FFEEXPR_parentypeSUBROUTINE_,
  139    FFEEXPR_parentypeARRAY_,
  140    FFEEXPR_parentypeSUBSTRING_,
  141    FFEEXPR_parentypeFUNSUBSTR_,/* Ambig: check for colon after first expr. */
  142    FFEEXPR_parentypeEQUIVALENCE_,	/* Ambig: ARRAY_ or SUBSTRING_. */
  143    FFEEXPR_parentypeANY_,	/* Allow basically anything. */
  144    FFEEXPR_parentype_
  145  } ffeexprParenType_;
  146
  147typedef enum
  148  {
  149    FFEEXPR_percentNONE_,
  150    FFEEXPR_percentLOC_,
  151    FFEEXPR_percentVAL_,
  152    FFEEXPR_percentREF_,
  153    FFEEXPR_percentDESCR_,
  154    FFEEXPR_percent_
  155  } ffeexprPercent_;
  156
  157/* Internal typedefs. */
  158
  159typedef struct _ffeexpr_expr_ *ffeexprExpr_;
  160typedef bool ffeexprOperatorAssociativity_;
  161typedef struct _ffeexpr_stack_ *ffeexprStack_;
  162
  163/* Private include files. */
  164
  165
  166/* Internal structure definitions. */
  167
  168struct _ffeexpr_expr_
  169  {
  170    ffeexprExpr_ previous;
  171    ffelexToken token;
  172    ffeexprExprtype_ type;
  173    union
  174      {
  175	struct
  176	  {
  177	    ffeexprOperator_ op;
  178	    ffeexprOperatorPrecedence_ prec;
  179	    ffeexprOperatorAssociativity_ as;
  180	  }
  181	operator;
  182	ffebld operand;
  183      }
  184    u;
  185  };
  186
  187struct _ffeexpr_stack_
  188  {
  189    ffeexprStack_ previous;
  190    mallocPool pool;
  191    ffeexprContext context;
  192    ffeexprCallback callback;
  193    ffelexToken first_token;
  194    ffeexprExpr_ exprstack;
  195    ffelexToken tokens[10];	/* Used in certain cases, like (unary)
  196				   open-paren. */
  197    ffebld expr;		/* For first of
  198				   complex/implied-do/substring/array-elements
  199				   / actual-args expression. */
  200    ffebld bound_list;		/* For tracking dimension bounds list of
  201				   array. */
  202    ffebldListBottom bottom;	/* For building lists. */
  203    ffeinfoRank rank;		/* For elements in an array reference. */
  204    bool constant;		/* TRUE while elements seen so far are
  205				   constants. */
  206    bool immediate;		/* TRUE while elements seen so far are
  207				   immediate/constants. */
  208    ffebld next_dummy;		/* Next SFUNC dummy arg in arg list. */
  209    ffebldListLength num_args;	/* Number of dummy args expected in arg list. */
  210    bool is_rhs;		/* TRUE if rhs context, FALSE otherwise. */
  211    ffeexprPercent_ percent;	/* Current %FOO keyword. */
  212  };
  213
  214struct _ffeexpr_find_
  215  {
  216    ffelexToken t;
  217    ffelexHandler after;
  218    int level;
  219  };
  220
  221/* Static objects accessed by functions in this module. */
  222
  223static ffeexprStack_ ffeexpr_stack_;	/* Expression stack for semantic. */
  224static ffelexToken ffeexpr_tokens_[10];	/* Scratchpad tokens for syntactic. */
  225static ffestrOther ffeexpr_current_dotdot_;	/* Current .FOO. keyword. */
  226static long ffeexpr_hollerith_count_;	/* ffeexpr_token_number_ and caller. */
  227static int ffeexpr_level_;	/* Level of DATA implied-DO construct. */
  228static bool ffeexpr_is_substr_ok_;	/* If OPEN_PAREN as binary "op" ok. */
  229static struct _ffeexpr_find_ ffeexpr_find_;
  230
  231/* Static functions (internal). */
  232
  233static ffelexHandler ffeexpr_cb_close_paren_ (ffelexToken ft, ffebld expr,
  234					      ffelexToken t);
  235static ffelexHandler ffeexpr_cb_close_paren_ambig_ (ffelexToken ft,
  236						    ffebld expr,
  237						    ffelexToken t);
  238static ffelexHandler ffeexpr_cb_close_paren_ambig_1_ (ffelexToken t);
  239static ffelexHandler ffeexpr_cb_close_paren_c_ (ffelexToken ft,
  240						ffebld expr, ffelexToken t);
  241static ffelexHandler ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr,
  242					  ffelexToken t);
  243static ffelexHandler ffeexpr_cb_close_paren_ci_ (ffelexToken ft,
  244						 ffebld expr, ffelexToken t);
  245static ffelexHandler ffeexpr_cb_comma_ci_ (ffelexToken ft, ffebld expr,
  246					   ffelexToken t);
  247static ffelexHandler ffeexpr_cb_comma_i_ (ffelexToken ft, ffebld expr,
  248					  ffelexToken t);
  249static ffelexHandler ffeexpr_cb_comma_i_1_ (ffelexToken ft, ffebld expr,
  250					    ffelexToken t);
  251static ffelexHandler ffeexpr_cb_comma_i_2_ (ffelexToken ft, ffebld expr,
  252					    ffelexToken t);
  253static ffelexHandler ffeexpr_cb_comma_i_3_ (ffelexToken ft, ffebld expr,
  254					    ffelexToken t);
  255static ffelexHandler ffeexpr_cb_comma_i_4_ (ffelexToken ft, ffebld expr,
  256					    ffelexToken t);
  257static ffelexHandler ffeexpr_cb_comma_i_5_ (ffelexToken t);
  258static ffelexHandler ffeexpr_cb_end_loc_ (ffelexToken ft, ffebld expr,
  259					  ffelexToken t);
  260static ffelexHandler ffeexpr_cb_end_notloc_ (ffelexToken ft, ffebld expr,
  261					     ffelexToken t);
  262static ffelexHandler ffeexpr_cb_end_notloc_1_ (ffelexToken t);
  263static ffesymbol ffeexpr_check_impctrl_ (ffesymbol s);
  264static void ffeexpr_check_impdo_ (ffebld list, ffelexToken list_t,
  265				  ffebld dovar, ffelexToken dovar_t);
  266static void ffeexpr_update_impdo_ (ffebld expr, ffebld dovar);
  267static void ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar);
  268static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s);
  269static ffeexprExpr_ ffeexpr_expr_new_ (void);
  270static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t);
  271static bool ffeexpr_isdigits_ (const char *p);
  272static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t);
  273static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t);
  274static ffelexHandler ffeexpr_token_first_rhs_ (ffelexToken t);
  275static ffelexHandler ffeexpr_token_first_rhs_1_ (ffelexToken t);
  276static ffelexHandler ffeexpr_token_first_rhs_2_ (ffelexToken t);
  277static ffelexHandler ffeexpr_token_first_rhs_3_ (ffelexToken t);
  278static ffelexHandler ffeexpr_token_first_rhs_4_ (ffelexToken t);
  279static ffelexHandler ffeexpr_token_first_rhs_5_ (ffelexToken t);
  280static ffelexHandler ffeexpr_token_first_rhs_6_ (ffelexToken t);
  281static ffelexHandler ffeexpr_token_namelist_ (ffelexToken t);
  282static void ffeexpr_expr_kill_ (ffeexprExpr_ e);
  283static void ffeexpr_exprstack_push_ (ffeexprExpr_ e);
  284static void ffeexpr_exprstack_push_binary_ (ffeexprExpr_ e);
  285static void ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e);
  286static void ffeexpr_exprstack_push_unary_ (ffeexprExpr_ e);
  287static void ffeexpr_reduce_ (void);
  288static ffebld ffeexpr_reduced_bool1_ (ffebld reduced, ffeexprExpr_ op,
  289				      ffeexprExpr_ r);
  290static ffebld ffeexpr_reduced_bool2_ (ffebld reduced, ffeexprExpr_ l,
  291				      ffeexprExpr_ op, ffeexprExpr_ r);
  292static ffebld ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l,
  293					    ffeexprExpr_ op, ffeexprExpr_ r);
  294static ffebld ffeexpr_reduced_eqop2_ (ffebld reduced, ffeexprExpr_ l,
  295				      ffeexprExpr_ op, ffeexprExpr_ r);
  296static ffebld ffeexpr_reduced_math1_ (ffebld reduced, ffeexprExpr_ op,
  297				      ffeexprExpr_ r);
  298static ffebld ffeexpr_reduced_math2_ (ffebld reduced, ffeexprExpr_ l,
  299				      ffeexprExpr_ op, ffeexprExpr_ r);
  300static ffebld ffeexpr_reduced_power_ (ffebld reduced, ffeexprExpr_ l,
  301				      ffeexprExpr_ op, ffeexprExpr_ r);
  302static ffebld ffeexpr_reduced_relop2_ (ffebld reduced, ffeexprExpr_ l,
  303				       ffeexprExpr_ op, ffeexprExpr_ r);
  304static ffebld ffeexpr_reduced_ugly1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r);
  305static ffebld ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op,
  306					 ffeexprExpr_ r);
  307static ffebld ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l,
  308				      ffeexprExpr_ op, ffeexprExpr_ r);
  309static ffebld ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l,
  310					 ffeexprExpr_ op, ffeexprExpr_ r);
  311static ffelexHandler ffeexpr_find_close_paren_ (ffelexToken t,
  312						ffelexHandler after);
  313static ffelexHandler ffeexpr_nil_finished_ (ffelexToken t);
  314static ffelexHandler ffeexpr_nil_rhs_ (ffelexToken t);
  315static ffelexHandler ffeexpr_nil_period_ (ffelexToken t);
  316static ffelexHandler ffeexpr_nil_end_period_ (ffelexToken t);
  317static ffelexHandler ffeexpr_nil_swallow_period_ (ffelexToken t);
  318static ffelexHandler ffeexpr_nil_real_ (ffelexToken t);
  319static ffelexHandler ffeexpr_nil_real_exponent_ (ffelexToken t);
  320static ffelexHandler ffeexpr_nil_real_exp_sign_ (ffelexToken t);
  321static ffelexHandler ffeexpr_nil_number_ (ffelexToken t);
  322static ffelexHandler ffeexpr_nil_number_exponent_ (ffelexToken t);
  323static ffelexHandler ffeexpr_nil_number_exp_sign_ (ffelexToken t);
  324static ffelexHandler ffeexpr_nil_number_period_ (ffelexToken t);
  325static ffelexHandler ffeexpr_nil_number_per_exp_ (ffelexToken t);
  326static ffelexHandler ffeexpr_nil_number_real_ (ffelexToken t);
  327static ffelexHandler ffeexpr_nil_num_per_exp_sign_ (ffelexToken t);
  328static ffelexHandler ffeexpr_nil_number_real_exp_ (ffelexToken t);
  329static ffelexHandler ffeexpr_nil_num_real_exp_sn_ (ffelexToken t);
  330static ffelexHandler ffeexpr_nil_binary_ (ffelexToken t);
  331static ffelexHandler ffeexpr_nil_binary_period_ (ffelexToken t);
  332static ffelexHandler ffeexpr_nil_binary_end_per_ (ffelexToken t);
  333static ffelexHandler ffeexpr_nil_binary_sw_per_ (ffelexToken t);
  334static ffelexHandler ffeexpr_nil_quote_ (ffelexToken t);
  335static ffelexHandler ffeexpr_nil_apostrophe_ (ffelexToken t);
  336static ffelexHandler ffeexpr_nil_apos_char_ (ffelexToken t);
  337static ffelexHandler ffeexpr_nil_name_rhs_ (ffelexToken t);
  338static ffelexHandler ffeexpr_nil_name_apos_ (ffelexToken t);
  339static ffelexHandler ffeexpr_nil_name_apos_name_ (ffelexToken t);
  340static ffelexHandler ffeexpr_nil_percent_ (ffelexToken t);
  341static ffelexHandler ffeexpr_nil_percent_name_ (ffelexToken t);
  342static ffelexHandler ffeexpr_nil_substrp_ (ffelexToken t);
  343static ffelexHandler ffeexpr_finished_ (ffelexToken t);
  344static ffebld ffeexpr_finished_ambig_ (ffelexToken t, ffebld expr);
  345static ffelexHandler ffeexpr_token_lhs_ (ffelexToken t);
  346static ffelexHandler ffeexpr_token_rhs_ (ffelexToken t);
  347static ffelexHandler ffeexpr_token_binary_ (ffelexToken t);
  348static ffelexHandler ffeexpr_token_period_ (ffelexToken t);
  349static ffelexHandler ffeexpr_token_end_period_ (ffelexToken t);
  350static ffelexHandler ffeexpr_token_swallow_period_ (ffelexToken t);
  351static ffelexHandler ffeexpr_token_real_ (ffelexToken t);
  352static ffelexHandler ffeexpr_token_real_exponent_ (ffelexToken t);
  353static ffelexHandler ffeexpr_token_real_exp_sign_ (ffelexToken t);
  354static ffelexHandler ffeexpr_token_number_ (ffelexToken t);
  355static ffelexHandler ffeexpr_token_number_exponent_ (ffelexToken t);
  356static ffelexHandler ffeexpr_token_number_exp_sign_ (ffelexToken t);
  357static ffelexHandler ffeexpr_token_number_period_ (ffelexToken t);
  358static ffelexHandler ffeexpr_token_number_per_exp_ (ffelexToken t);
  359static ffelexHandler ffeexpr_token_number_real_ (ffelexToken t);
  360static ffelexHandler ffeexpr_token_num_per_exp_sign_ (ffelexToken t);
  361static ffelexHandler ffeexpr_token_number_real_exp_ (ffelexToken t);
  362static ffelexHandler ffeexpr_token_num_real_exp_sn_ (ffelexToken t);
  363static ffelexHandler ffeexpr_token_binary_period_ (ffelexToken t);
  364static ffelexHandler ffeexpr_token_binary_end_per_ (ffelexToken t);
  365static ffelexHandler ffeexpr_token_binary_sw_per_ (ffelexToken t);
  366static ffelexHandler ffeexpr_token_quote_ (ffelexToken t);
  367static ffelexHandler ffeexpr_token_apostrophe_ (ffelexToken t);
  368static ffelexHandler ffeexpr_token_apos_char_ (ffelexToken t);
  369static ffelexHandler ffeexpr_token_name_lhs_ (ffelexToken t);
  370static ffelexHandler ffeexpr_token_name_arg_ (ffelexToken t);
  371static ffelexHandler ffeexpr_token_name_rhs_ (ffelexToken t);
  372static ffelexHandler ffeexpr_token_name_apos_ (ffelexToken t);
  373static ffelexHandler ffeexpr_token_name_apos_name_ (ffelexToken t);
  374static ffelexHandler ffeexpr_token_percent_ (ffelexToken t);
  375static ffelexHandler ffeexpr_token_percent_name_ (ffelexToken t);
  376static ffelexHandler ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr,
  377					       ffelexToken t);
  378static ffelexHandler ffeexpr_token_elements_ (ffelexToken ft, ffebld expr,
  379					      ffelexToken t);
  380static ffelexHandler ffeexpr_token_equivalence_ (ffelexToken ft, ffebld expr,
  381						 ffelexToken t);
  382static ffelexHandler ffeexpr_token_substring_ (ffelexToken ft, ffebld expr,
  383					       ffelexToken t);
  384static ffelexHandler ffeexpr_token_substring_1_ (ffelexToken ft, ffebld expr,
  385						 ffelexToken t);
  386static ffelexHandler ffeexpr_token_substrp_ (ffelexToken t);
  387static ffelexHandler ffeexpr_token_intrincheck_ (ffelexToken t);
  388static ffelexHandler ffeexpr_token_funsubstr_ (ffelexToken ft, ffebld expr,
  389					       ffelexToken t);
  390static ffelexHandler ffeexpr_token_anything_ (ffelexToken ft, ffebld expr,
  391					      ffelexToken t);
  392static void ffeexpr_make_float_const_ (char exp_letter, ffelexToken integer,
  393	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
  394		    ffelexToken exponent_sign, ffelexToken exponent_digits);
  395static ffesymbol ffeexpr_declare_unadorned_ (ffelexToken t, bool maybe_intrin);
  396static ffesymbol ffeexpr_sym_impdoitem_ (ffesymbol s, ffelexToken t);
  397static ffesymbol ffeexpr_sym_lhs_call_ (ffesymbol s, ffelexToken t);
  398static ffesymbol ffeexpr_sym_lhs_data_ (ffesymbol s, ffelexToken t);
  399static ffesymbol ffeexpr_sym_lhs_equivalence_ (ffesymbol s, ffelexToken t);
  400static ffesymbol ffeexpr_sym_lhs_extfunc_ (ffesymbol s, ffelexToken t);
  401static ffesymbol ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, ffelexToken t);
  402static ffesymbol ffeexpr_sym_lhs_parameter_ (ffesymbol s, ffelexToken t);
  403static ffesymbol ffeexpr_sym_rhs_actualarg_ (ffesymbol s, ffelexToken t);
  404static ffesymbol ffeexpr_sym_rhs_dimlist_ (ffesymbol s, ffelexToken t);
  405static ffesymbol ffeexpr_sym_rhs_let_ (ffesymbol s, ffelexToken t);
  406static ffesymbol ffeexpr_declare_parenthesized_ (ffelexToken t,
  407						 bool maybe_intrin,
  408					     ffeexprParenType_ *paren_type);
  409static ffesymbol ffeexpr_paren_rhs_let_ (ffesymbol s, ffelexToken t);
  410
  411/* Internal macros. */
  412
  413#define ffeexpr_paren_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
  414#define ffeexpr_sym_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
  415
  416/* ffeexpr_collapse_convert -- Collapse convert expr
  417
  418   ffebld expr;
  419   ffelexToken token;
  420   expr = ffeexpr_collapse_convert(expr,token);
  421
  422   If the result of the expr is a constant, replaces the expr with the
  423   computed constant.  */
  424
  425ffebld
  426ffeexpr_collapse_convert (ffebld expr, ffelexToken t)
  427{
  428  ffebad error = FFEBAD;
  429  ffebld l;
  430  ffebldConstantUnion u;
  431  ffeinfoBasictype bt;
  432  ffeinfoKindtype kt;
  433  ffetargetCharacterSize sz;
  434  ffetargetCharacterSize sz2;
  435
  436  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
  437    return expr;
  438
  439  l = ffebld_left (expr);
  440
  441  if (ffebld_op (l) != FFEBLD_opCONTER)
  442    return expr;
  443
  444  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
  445    {
  446    case FFEINFO_basictypeANY:
  447      return expr;
  448
  449    case FFEINFO_basictypeINTEGER:
  450      sz = FFETARGET_charactersizeNONE;
  451      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
  452	{
  453#if FFETARGET_okINTEGER1
  454	case FFEINFO_kindtypeINTEGER1:
  455	  switch (ffeinfo_basictype (ffebld_info (l)))
  456	    {
  457	    case FFEINFO_basictypeINTEGER:
  458	      switch (ffeinfo_kindtype (ffebld_info (l)))
  459		{
  460#if FFETARGET_okINTEGER2
  461		case FFEINFO_kindtypeINTEGER2:
  462		  error = ffetarget_convert_integer1_integer2
  463		    (ffebld_cu_ptr_integer1 (u),
  464		     ffebld_constant_integer2 (ffebld_conter (l)));
  465		  break;
  466#endif
  467
  468#if FFETARGET_okINTEGER3
  469		case FFEINFO_kindtypeINTEGER3:
  470		  error = ffetarget_convert_integer1_integer3
  471		    (ffebld_cu_ptr_integer1 (u),
  472		     ffebld_constant_integer3 (ffebld_conter (l)));
  473		  break;
  474#endif
  475
  476#if FFETARGET_okINTEGER4
  477		case FFEINFO_kindtypeINTEGER4:
  478		  error = ffetarget_convert_integer1_integer4
  479		    (ffebld_cu_ptr_integer1 (u),
  480		     ffebld_constant_integer4 (ffebld_conter (l)));
  481		  break;
  482#endif
  483
  484		default:
  485		  assert ("INTEGER1/INTEGER bad source kind type" == NULL);
  486		  break;
  487		}
  488	      break;
  489
  490	    case FFEINFO_basictypeREAL:
  491	      switch (ffeinfo_kindtype (ffebld_info (l)))
  492		{
  493#if FFETARGET_okREAL1
  494		case FFEINFO_kindtypeREAL1:
  495		  error = ffetarget_convert_integer1_real1
  496		    (ffebld_cu_ptr_integer1 (u),
  497		     ffebld_constant_real1 (ffebld_conter (l)));
  498		  break;
  499#endif
  500
  501#if FFETARGET_okREAL2
  502		case FFEINFO_kindtypeREAL2:
  503		  error = ffetarget_convert_integer1_real2
  504		    (ffebld_cu_ptr_integer1 (u),
  505		     ffebld_constant_real2 (ffebld_conter (l)));
  506		  break;
  507#endif
  508
  509#if FFETARGET_okREAL3
  510		case FFEINFO_kindtypeREAL3:
  511		  error = ffetarget_convert_integer1_real3
  512		    (ffebld_cu_ptr_integer1 (u),
  513		     ffebld_constant_real3 (ffebld_conter (l)));
  514		  break;
  515#endif
  516
  517#if FFETARGET_okREAL4
  518		case FFEINFO_kindtypeREAL4:
  519		  error = ffetarget_convert_integer1_real4
  520		    (ffebld_cu_ptr_integer1 (u),
  521		     ffebld_constant_real4 (ffebld_conter (l)));
  522		  break;
  523#endif
  524
  525		default:
  526		  assert ("INTEGER1/REAL bad source kind type" == NULL);
  527		  break;
  528		}
  529	      break;
  530
  531	    case FFEINFO_basictypeCOMPLEX:
  532	      switch (ffeinfo_kindtype (ffebld_info (l)))
  533		{
  534#if FFETARGET_okCOMPLEX1
  535		case FFEINFO_kindtypeREAL1:
  536		  error = ffetarget_convert_integer1_complex1
  537		    (ffebld_cu_ptr_integer1 (u),
  538		     ffebld_constant_complex1 (ffebld_conter (l)));
  539		  break;
  540#endif
  541
  542#if FFETARGET_okCOMPLEX2
  543		case FFEINFO_kindtypeREAL2:
  544		  error = ffetarget_convert_integer1_complex2
  545		    (ffebld_cu_ptr_integer1 (u),
  546		     ffebld_constant_complex2 (ffebld_conter (l)));
  547		  break;
  548#endif
  549
  550#if FFETARGET_okCOMPLEX3
  551		case FFEINFO_kindtypeREAL3:
  552		  error = ffetarget_convert_integer1_complex3
  553		    (ffebld_cu_ptr_integer1 (u),
  554		     ffebld_constant_complex3 (ffebld_conter (l)));
  555		  break;
  556#endif
  557
  558#if FFETARGET_okCOMPLEX4
  559		case FFEINFO_kindtypeREAL4:
  560		  error = ffetarget_convert_integer1_complex4
  561		    (ffebld_cu_ptr_integer1 (u),
  562		     ffebld_constant_complex4 (ffebld_conter (l)));
  563		  break;
  564#endif
  565
  566		default:
  567		  assert ("INTEGER1/COMPLEX bad source kind type" == NULL);
  568		  break;
  569		}
  570	      break;
  571
  572	    case FFEINFO_basictypeLOGICAL:
  573	      switch (ffeinfo_kindtype (ffebld_info (l)))
  574		{
  575#if FFETARGET_okLOGICAL1
  576		case FFEINFO_kindtypeLOGICAL1:
  577		  error = ffetarget_convert_integer1_logical1
  578		    (ffebld_cu_ptr_integer1 (u),
  579		     ffebld_constant_logical1 (ffebld_conter (l)));
  580		  break;
  581#endif
  582
  583#if FFETARGET_okLOGICAL2
  584		case FFEINFO_kindtypeLOGICAL2:
  585		  error = ffetarget_convert_integer1_logical2
  586		    (ffebld_cu_ptr_integer1 (u),
  587		     ffebld_constant_logical2 (ffebld_conter (l)));
  588		  break;
  589#endif
  590
  591#if FFETARGET_okLOGICAL3
  592		case FFEINFO_kindtypeLOGICAL3:
  593		  error = ffetarget_convert_integer1_logical3
  594		    (ffebld_cu_ptr_integer1 (u),
  595		     ffebld_constant_logical3 (ffebld_conter (l)));
  596		  break;
  597#endif
  598
  599#if FFETARGET_okLOGICAL4
  600		case FFEINFO_kindtypeLOGICAL4:
  601		  error = ffetarget_convert_integer1_logical4
  602		    (ffebld_cu_ptr_integer1 (u),
  603		     ffebld_constant_logical4 (ffebld_conter (l)));
  604		  break;
  605#endif
  606
  607		default:
  608		  assert ("INTEGER1/LOGICAL bad source kind type" == NULL);
  609		  break;
  610		}
  611	      break;
  612
  613	    case FFEINFO_basictypeCHARACTER:
  614	      error = ffetarget_convert_integer1_character1
  615		(ffebld_cu_ptr_integer1 (u),
  616		 ffebld_constant_character1 (ffebld_conter (l)));
  617	      break;
  618
  619	    case FFEINFO_basictypeHOLLERITH:
  620	      error = ffetarget_convert_integer1_hollerith
  621		(ffebld_cu_ptr_integer1 (u),
  622		 ffebld_constant_hollerith (ffebld_conter (l)));
  623	      break;
  624
  625	    case FFEINFO_basictypeTYPELESS:
  626	      error = ffetarget_convert_integer1_typeless
  627		(ffebld_cu_ptr_integer1 (u),
  628		 ffebld_constant_typeless (ffebld_conter (l)));
  629	      break;
  630
  631	    default:
  632	      assert ("INTEGER1 bad type" == NULL);
  633	      break;
  634	    }
  635
  636	  /* If conversion operation is not implemented, return original expr.  */
  637	  if (error == FFEBAD_NOCANDO)
  638	    return expr;
  639
  640	  expr = ffebld_new_conter_with_orig
  641	    (ffebld_constant_new_integer1_val
  642	     (ffebld_cu_val_integer1 (u)), expr);
  643	  break;
  644#endif
  645
  646#if FFETARGET_okINTEGER2
  647	case FFEINFO_kindtypeINTEGER2:
  648	  switch (ffeinfo_basictype (ffebld_info (l)))
  649	    {
  650	    case FFEINFO_basictypeINTEGER:
  651	      switch (ffeinfo_kindtype (ffebld_info (l)))
  652		{
  653#if FFETARGET_okINTEGER1
  654		case FFEINFO_kindtypeINTEGER1:
  655		  error = ffetarget_convert_integer2_integer1
  656		    (ffebld_cu_ptr_integer2 (u),
  657		     ffebld_constant_integer1 (ffebld_conter (l)));
  658		  break;
  659#endif
  660
  661#if FFETARGET_okINTEGER3
  662		case FFEINFO_kindtypeINTEGER3:
  663		  error = ffetarget_convert_integer2_integer3
  664		    (ffebld_cu_ptr_integer2 (u),
  665		     ffebld_constant_integer3 (ffebld_conter (l)));
  666		  break;
  667#endif
  668
  669#if FFETARGET_okINTEGER4
  670		case FFEINFO_kindtypeINTEGER4:
  671		  error = ffetarget_convert_integer2_integer4
  672		    (ffebld_cu_ptr_integer2 (u),
  673		     ffebld_constant_integer4 (ffebld_conter (l)));
  674		  break;
  675#endif
  676
  677		default:
  678		  assert ("INTEGER2/INTEGER bad source kind type" == NULL);
  679		  break;
  680		}
  681	      break;
  682
  683	    case FFEINFO_basictypeREAL:
  684	      switch (ffeinfo_kindtype (ffebld_info (l)))
  685		{
  686#if FFETARGET_okREAL1
  687		case FFEINFO_kindtypeREAL1:
  688		  error = ffetarget_convert_integer2_real1
  689		    (ffebld_cu_ptr_integer2 (u),
  690		     ffebld_constant_real1 (ffebld_conter (l)));
  691		  break;
  692#endif
  693
  694#if FFETARGET_okREAL2
  695		case FFEINFO_kindtypeREAL2:
  696		  error = ffetarget_convert_integer2_real2
  697		    (ffebld_cu_ptr_integer2 (u),
  698		     ffebld_constant_real2 (ffebld_conter (l)));
  699		  break;
  700#endif
  701
  702#if FFETARGET_okREAL3
  703		case FFEINFO_kindtypeREAL3:
  704		  error = ffetarget_convert_integer2_real3
  705		    (ffebld_cu_ptr_integer2 (u),
  706		     ffebld_constant_real3 (ffebld_conter (l)));
  707		  break;
  708#endif
  709
  710#if FFETARGET_okREAL4
  711		case FFEINFO_kindtypeREAL4:
  712		  error = ffetarget_convert_integer2_real4
  713		    (ffebld_cu_ptr_integer2 (u),
  714		     ffebld_constant_real4 (ffebld_conter (l)));
  715		  break;
  716#endif
  717
  718		default:
  719		  assert ("INTEGER2/REAL bad source kind type" == NULL);
  720		  break;
  721		}
  722	      break;
  723
  724	    case FFEINFO_basictypeCOMPLEX:
  725	      switch (ffeinfo_kindtype (ffebld_info (l)))
  726		{
  727#if FFETARGET_okCOMPLEX1
  728		case FFEINFO_kindtypeREAL1:
  729		  error = ffetarget_convert_integer2_complex1
  730		    (ffebld_cu_ptr_integer2 (u),
  731		     ffebld_constant_complex1 (ffebld_conter (l)));
  732		  break;
  733#endif
  734
  735#if FFETARGET_okCOMPLEX2
  736		case FFEINFO_kindtypeREAL2:
  737		  error = ffetarget_convert_integer2_complex2
  738		    (ffebld_cu_ptr_integer2 (u),
  739		     ffebld_constant_complex2 (ffebld_conter (l)));
  740		  break;
  741#endif
  742
  743#if FFETARGET_okCOMPLEX3
  744		case FFEINFO_kindtypeREAL3:
  745		  error = ffetarget_convert_integer2_complex3
  746		    (ffebld_cu_ptr_integer2 (u),
  747		     ffebld_constant_complex3 (ffebld_conter (l)));
  748		  break;
  749#endif
  750
  751#if FFETARGET_okCOMPLEX4
  752		case FFEINFO_kindtypeREAL4:
  753		  error = ffetarget_convert_integer2_complex4
  754		    (ffebld_cu_ptr_integer2 (u),
  755		     ffebld_constant_complex4 (ffebld_conter (l)));
  756		  break;
  757#endif
  758
  759		default:
  760		  assert ("INTEGER2/COMPLEX bad source kind type" == NULL);
  761		  break;
  762		}
  763	      break;
  764
  765	    case FFEINFO_basictypeLOGICAL:
  766	      switch (ffeinfo_kindtype (ffebld_info (l)))
  767		{
  768#if FFETARGET_okLOGICAL1
  769		case FFEINFO_kindtypeLOGICAL1:
  770		  error = ffetarget_convert_integer2_logical1
  771		    (ffebld_cu_ptr_integer2 (u),
  772		     ffebld_constant_logical1 (ffebld_conter (l)));
  773		  break;
  774#endif
  775
  776#if FFETARGET_okLOGICAL2
  777		case FFEINFO_kindtypeLOGICAL2:
  778		  error = ffetarget_convert_integer2_logical2
  779		    (ffebld_cu_ptr_integer2 (u),
  780		     ffebld_constant_logical2 (ffebld_conter (l)));
  781		  break;
  782#endif
  783
  784#if FFETARGET_okLOGICAL3
  785		case FFEINFO_kindtypeLOGICAL3:
  786		  error = ffetarget_convert_integer2_logical3
  787		    (ffebld_cu_ptr_integer2 (u),
  788		     ffebld_constant_logical3 (ffebld_conter (l)));
  789		  break;
  790#endif
  791
  792#if FFETARGET_okLOGICAL4
  793		case FFEINFO_kindtypeLOGICAL4:
  794		  error = ffetarget_convert_integer2_logical4
  795		    (ffebld_cu_ptr_integer2 (u),
  796		     ffebld_constant_logical4 (ffebld_conter (l)));
  797		  break;
  798#endif
  799
  800		default:
  801		  assert ("INTEGER2/LOGICAL bad source kind type" == NULL);
  802		  break;
  803		}
  804	      break;
  805
  806	    case FFEINFO_basictypeCHARACTER:
  807	      error = ffetarget_convert_integer2_character1
  808		(ffebld_cu_ptr_integer2 (u),
  809		 ffebld_constant_character1 (ffebld_conter (l)));
  810	      break;
  811
  812	    case FFEINFO_basictypeHOLLERITH:
  813	      error = ffetarget_convert_integer2_hollerith
  814		(ffebld_cu_ptr_integer2 (u),
  815		 ffebld_constant_hollerith (ffebld_conter (l)));
  816	      break;
  817
  818	    case FFEINFO_basictypeTYPELESS:
  819	      error = ffetarget_convert_integer2_typeless
  820		(ffebld_cu_ptr_integer2 (u),
  821		 ffebld_constant_typeless (ffebld_conter (l)));
  822	      break;
  823
  824	    default:
  825	      assert ("INTEGER2 bad type" == NULL);
  826	      break;
  827	    }
  828
  829	  /* If conversion operation is not implemented, return original expr.  */
  830	  if (error == FFEBAD_NOCANDO)
  831	    return expr;
  832
  833	  expr = ffebld_new_conter_with_orig
  834	    (ffebld_constant_new_integer2_val
  835	     (ffebld_cu_val_integer2 (u)), expr);
  836	  break;
  837#endif
  838
  839#if FFETARGET_okINTEGER3
  840	case FFEINFO_kindtypeINTEGER3:
  841	  switch (ffeinfo_basictype (ffebld_info (l)))
  842	    {
  843	    case FFEINFO_basictypeINTEGER:
  844	      switch (ffeinfo_kindtype (ffebld_info (l)))
  845		{
  846#if FFETARGET_okINTEGER1
  847		case FFEINFO_kindtypeINTEGER1:
  848		  error = ffetarget_convert_integer3_integer1
  849		    (ffebld_cu_ptr_integer3 (u),
  850		     ffebld_constant_integer1 (ffebld_conter (l)));
  851		  break;
  852#endif
  853
  854#if FFETARGET_okINTEGER2
  855		case FFEINFO_kindtypeINTEGER2:
  856		  error = ffetarget_convert_integer3_integer2
  857		    (ffebld_cu_ptr_integer3 (u),
  858		     ffebld_constant_integer2 (ffebld_conter (l)));
  859		  break;
  860#endif
  861
  862#if FFETARGET_okINTEGER4
  863		case FFEINFO_kindtypeINTEGER4:
  864		  error = ffetarget_convert_integer3_integer4
  865		    (ffebld_cu_ptr_integer3 (u),
  866		     ffebld_constant_integer4 (ffebld_conter (l)));
  867		  break;
  868#endif
  869
  870		default:
  871		  assert ("INTEGER3/INTEGER bad source kind type" == NULL);
  872		  break;
  873		}
  874	      break;
  875
  876	    case FFEINFO_basictypeREAL:
  877	      switch (ffeinfo_kindtype (ffebld_info (l)))
  878		{
  879#if FFETARGET_okREAL1
  880		case FFEINFO_kindtypeREAL1:
  881		  error = ffetarget_convert_integer3_real1
  882		    (ffebld_cu_ptr_integer3 (u),
  883		     ffebld_constant_real1 (ffebld_conter (l)));
  884		  break;
  885#endif
  886
  887#if FFETARGET_okREAL2
  888		case FFEINFO_kindtypeREAL2:
  889		  error = ffetarget_convert_integer3_real2
  890		    (ffebld_cu_ptr_integer3 (u),
  891		     ffebld_constant_real2 (ffebld_conter (l)));
  892		  break;
  893#endif
  894
  895#if FFETARGET_okREAL3
  896		case FFEINFO_kindtypeREAL3:
  897		  error = ffetarget_convert_integer3_real3
  898		    (ffebld_cu_ptr_integer3 (u),
  899		     ffebld_constant_real3 (ffebld_conter (l)));
  900		  break;
  901#endif
  902
  903#if FFETARGET_okREAL4
  904		case FFEINFO_kindtypeREAL4:
  905		  error = ffetarget_convert_integer3_real4
  906		    (ffebld_cu_ptr_integer3 (u),
  907		     ffebld_constant_real4 (ffebld_conter (l)));
  908		  break;
  909#endif
  910
  911		default:
  912		  assert ("INTEGER3/REAL bad source kind type" == NULL);
  913		  break;
  914		}
  915	      break;
  916
  917	    case FFEINFO_basictypeCOMPLEX:
  918	      switch (ffeinfo_kindtype (ffebld_info (l)))
  919		{
  920#if FFETARGET_okCOMPLEX1
  921		case FFEINFO_kindtypeREAL1:
  922		  error = ffetarget_convert_integer3_complex1
  923		    (ffebld_cu_ptr_integer3 (u),
  924		     ffebld_constant_complex1 (ffebld_conter (l)));
  925		  break;
  926#endif
  927
  928#if FFETARGET_okCOMPLEX2
  929		case FFEINFO_kindtypeREAL2:
  930		  error = ffetarget_convert_integer3_complex2
  931		    (ffebld_cu_ptr_integer3 (u),
  932		     ffebld_constant_complex2 (ffebld_conter (l)));
  933		  break;
  934#endif
  935
  936#if FFETARGET_okCOMPLEX3
  937		case FFEINFO_kindtypeREAL3:
  938		  error = ffetarget_convert_integer3_complex3
  939		    (ffebld_cu_ptr_integer3 (u),
  940		     ffebld_constant_complex3 (ffebld_conter (l)));
  941		  break;
  942#endif
  943
  944#if FFETARGET_okCOMPLEX4
  945		case FFEINFO_kindtypeREAL4:
  946		  error = ffetarget_convert_integer3_complex4
  947		    (ffebld_cu_ptr_integer3 (u),
  948		     ffebld_constant_complex4 (ffebld_conter (l)));
  949		  break;
  950#endif
  951
  952		default:
  953		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
  954		  break;
  955		}
  956	      break;
  957
  958	    case FFEINFO_basictypeLOGICAL:
  959	      switch (ffeinfo_kindtype (ffebld_info (l)))
  960		{
  961#if FFETARGET_okLOGICAL1
  962		case FFEINFO_kindtypeLOGICAL1:
  963		  error = ffetarget_convert_integer3_logical1
  964		    (ffebld_cu_ptr_integer3 (u),
  965		     ffebld_constant_logical1 (ffebld_conter (l)));
  966		  break;
  967#endif
  968
  969#if FFETARGET_okLOGICAL2
  970		case FFEINFO_kindtypeLOGICAL2:
  971		  error = ffetarget_convert_integer3_logical2
  972		    (ffebld_cu_ptr_integer3 (u),
  973		     ffebld_constant_logical2 (ffebld_conter (l)));
  974		  break;
  975#endif
  976
  977#if FFETARGET_okLOGICAL3
  978		case FFEINFO_kindtypeLOGICAL3:
  979		  error = ffetarget_convert_integer3_logical3
  980		    (ffebld_cu_ptr_integer3 (u),
  981		     ffebld_constant_logical3 (ffebld_conter (l)));
  982		  break;
  983#endif
  984
  985#if FFETARGET_okLOGICAL4
  986		case FFEINFO_kindtypeLOGICAL4:
  987		  error = ffetarget_convert_integer3_logical4
  988		    (ffebld_cu_ptr_integer3 (u),
  989		     ffebld_constant_logical4 (ffebld_conter (l)));
  990		  break;
  991#endif
  992
  993		default:
  994		  assert ("INTEGER3/LOGICAL bad source kind type" == NULL);
  995		  break;
  996		}
  997	      break;
  998
  999	    case FFEINFO_basictypeCHARACTER:
 1000	      error = ffetarget_convert_integer3_character1
 1001		(ffebld_cu_ptr_integer3 (u),
 1002		 ffebld_constant_character1 (ffebld_conter (l)));
 1003	      break;
 1004
 1005	    case FFEINFO_basictypeHOLLERITH:
 1006	      error = ffetarget_convert_integer3_hollerith
 1007		(ffebld_cu_ptr_integer3 (u),
 1008		 ffebld_constant_hollerith (ffebld_conter (l)));
 1009	      break;
 1010
 1011	    case FFEINFO_basictypeTYPELESS:
 1012	      error = ffetarget_convert_integer3_typeless
 1013		(ffebld_cu_ptr_integer3 (u),
 1014		 ffebld_constant_typeless (ffebld_conter (l)));
 1015	      break;
 1016
 1017	    default:
 1018	      assert ("INTEGER3 bad type" == NULL);
 1019	      break;
 1020	    }
 1021
 1022	  /* If conversion operation is not implemented, return original expr.  */
 1023	  if (error == FFEBAD_NOCANDO)
 1024	    return expr;
 1025
 1026	  expr = ffebld_new_conter_with_orig
 1027	    (ffebld_constant_new_integer3_val
 1028	     (ffebld_cu_val_integer3 (u)), expr);
 1029	  break;
 1030#endif
 1031
 1032#if FFETARGET_okINTEGER4
 1033	case FFEINFO_kindtypeINTEGER4:
 1034	  switch (ffeinfo_basictype (ffebld_info (l)))
 1035	    {
 1036	    case FFEINFO_basictypeINTEGER:
 1037	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1038		{
 1039#if FFETARGET_okINTEGER1
 1040		case FFEINFO_kindtypeINTEGER1:
 1041		  error = ffetarget_convert_integer4_integer1
 1042		    (ffebld_cu_ptr_integer4 (u),
 1043		     ffebld_constant_integer1 (ffebld_conter (l)));
 1044		  break;
 1045#endif
 1046
 1047#if FFETARGET_okINTEGER2
 1048		case FFEINFO_kindtypeINTEGER2:
 1049		  error = ffetarget_convert_integer4_integer2
 1050		    (ffebld_cu_ptr_integer4 (u),
 1051		     ffebld_constant_integer2 (ffebld_conter (l)));
 1052		  break;
 1053#endif
 1054
 1055#if FFETARGET_okINTEGER3
 1056		case FFEINFO_kindtypeINTEGER3:
 1057		  error = ffetarget_convert_integer4_integer3
 1058		    (ffebld_cu_ptr_integer4 (u),
 1059		     ffebld_constant_integer3 (ffebld_conter (l)));
 1060		  break;
 1061#endif
 1062
 1063		default:
 1064		  assert ("INTEGER4/INTEGER bad source kind type" == NULL);
 1065		  break;
 1066		}
 1067	      break;
 1068
 1069	    case FFEINFO_basictypeREAL:
 1070	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1071		{
 1072#if FFETARGET_okREAL1
 1073		case FFEINFO_kindtypeREAL1:
 1074		  error = ffetarget_convert_integer4_real1
 1075		    (ffebld_cu_ptr_integer4 (u),
 1076		     ffebld_constant_real1 (ffebld_conter (l)));
 1077		  break;
 1078#endif
 1079
 1080#if FFETARGET_okREAL2
 1081		case FFEINFO_kindtypeREAL2:
 1082		  error = ffetarget_convert_integer4_real2
 1083		    (ffebld_cu_ptr_integer4 (u),
 1084		     ffebld_constant_real2 (ffebld_conter (l)));
 1085		  break;
 1086#endif
 1087
 1088#if FFETARGET_okREAL3
 1089		case FFEINFO_kindtypeREAL3:
 1090		  error = ffetarget_convert_integer4_real3
 1091		    (ffebld_cu_ptr_integer4 (u),
 1092		     ffebld_constant_real3 (ffebld_conter (l)));
 1093		  break;
 1094#endif
 1095
 1096#if FFETARGET_okREAL4
 1097		case FFEINFO_kindtypeREAL4:
 1098		  error = ffetarget_convert_integer4_real4
 1099		    (ffebld_cu_ptr_integer4 (u),
 1100		     ffebld_constant_real4 (ffebld_conter (l)));
 1101		  break;
 1102#endif
 1103
 1104		default:
 1105		  assert ("INTEGER4/REAL bad source kind type" == NULL);
 1106		  break;
 1107		}
 1108	      break;
 1109
 1110	    case FFEINFO_basictypeCOMPLEX:
 1111	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1112		{
 1113#if FFETARGET_okCOMPLEX1
 1114		case FFEINFO_kindtypeREAL1:
 1115		  error = ffetarget_convert_integer4_complex1
 1116		    (ffebld_cu_ptr_integer4 (u),
 1117		     ffebld_constant_complex1 (ffebld_conter (l)));
 1118		  break;
 1119#endif
 1120
 1121#if FFETARGET_okCOMPLEX2
 1122		case FFEINFO_kindtypeREAL2:
 1123		  error = ffetarget_convert_integer4_complex2
 1124		    (ffebld_cu_ptr_integer4 (u),
 1125		     ffebld_constant_complex2 (ffebld_conter (l)));
 1126		  break;
 1127#endif
 1128
 1129#if FFETARGET_okCOMPLEX3
 1130		case FFEINFO_kindtypeREAL3:
 1131		  error = ffetarget_convert_integer4_complex3
 1132		    (ffebld_cu_ptr_integer4 (u),
 1133		     ffebld_constant_complex3 (ffebld_conter (l)));
 1134		  break;
 1135#endif
 1136
 1137#if FFETARGET_okCOMPLEX4
 1138		case FFEINFO_kindtypeREAL4:
 1139		  error = ffetarget_convert_integer4_complex4
 1140		    (ffebld_cu_ptr_integer4 (u),
 1141		     ffebld_constant_complex4 (ffebld_conter (l)));
 1142		  break;
 1143#endif
 1144
 1145		default:
 1146		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
 1147		  break;
 1148		}
 1149	      break;
 1150
 1151	    case FFEINFO_basictypeLOGICAL:
 1152	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1153		{
 1154#if FFETARGET_okLOGICAL1
 1155		case FFEINFO_kindtypeLOGICAL1:
 1156		  error = ffetarget_convert_integer4_logical1
 1157		    (ffebld_cu_ptr_integer4 (u),
 1158		     ffebld_constant_logical1 (ffebld_conter (l)));
 1159		  break;
 1160#endif
 1161
 1162#if FFETARGET_okLOGICAL2
 1163		case FFEINFO_kindtypeLOGICAL2:
 1164		  error = ffetarget_convert_integer4_logical2
 1165		    (ffebld_cu_ptr_integer4 (u),
 1166		     ffebld_constant_logical2 (ffebld_conter (l)));
 1167		  break;
 1168#endif
 1169
 1170#if FFETARGET_okLOGICAL3
 1171		case FFEINFO_kindtypeLOGICAL3:
 1172		  error = ffetarget_convert_integer4_logical3
 1173		    (ffebld_cu_ptr_integer4 (u),
 1174		     ffebld_constant_logical3 (ffebld_conter (l)));
 1175		  break;
 1176#endif
 1177
 1178#if FFETARGET_okLOGICAL4
 1179		case FFEINFO_kindtypeLOGICAL4:
 1180		  error = ffetarget_convert_integer4_logical4
 1181		    (ffebld_cu_ptr_integer4 (u),
 1182		     ffebld_constant_logical4 (ffebld_conter (l)));
 1183		  break;
 1184#endif
 1185
 1186		default:
 1187		  assert ("INTEGER4/LOGICAL bad source kind type" == NULL);
 1188		  break;
 1189		}
 1190	      break;
 1191
 1192	    case FFEINFO_basictypeCHARACTER:
 1193	      error = ffetarget_convert_integer4_character1
 1194		(ffebld_cu_ptr_integer4 (u),
 1195		 ffebld_constant_character1 (ffebld_conter (l)));
 1196	      break;
 1197
 1198	    case FFEINFO_basictypeHOLLERITH:
 1199	      error = ffetarget_convert_integer4_hollerith
 1200		(ffebld_cu_ptr_integer4 (u),
 1201		 ffebld_constant_hollerith (ffebld_conter (l)));
 1202	      break;
 1203
 1204	    case FFEINFO_basictypeTYPELESS:
 1205	      error = ffetarget_convert_integer4_typeless
 1206		(ffebld_cu_ptr_integer4 (u),
 1207		 ffebld_constant_typeless (ffebld_conter (l)));
 1208	      break;
 1209
 1210	    default:
 1211	      assert ("INTEGER4 bad type" == NULL);
 1212	      break;
 1213	    }
 1214
 1215	  /* If conversion operation is not implemented, return original expr.  */
 1216	  if (error == FFEBAD_NOCANDO)
 1217	    return expr;
 1218
 1219	  expr = ffebld_new_conter_with_orig
 1220	    (ffebld_constant_new_integer4_val
 1221	     (ffebld_cu_val_integer4 (u)), expr);
 1222	  break;
 1223#endif
 1224
 1225	default:
 1226	  assert ("bad integer kind type" == NULL);
 1227	  break;
 1228	}
 1229      break;
 1230
 1231    case FFEINFO_basictypeLOGICAL:
 1232      sz = FFETARGET_charactersizeNONE;
 1233      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 1234	{
 1235#if FFETARGET_okLOGICAL1
 1236	case FFEINFO_kindtypeLOGICAL1:
 1237	  switch (ffeinfo_basictype (ffebld_info (l)))
 1238	    {
 1239	    case FFEINFO_basictypeLOGICAL:
 1240	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1241		{
 1242#if FFETARGET_okLOGICAL2
 1243		case FFEINFO_kindtypeLOGICAL2:
 1244		  error = ffetarget_convert_logical1_logical2
 1245		    (ffebld_cu_ptr_logical1 (u),
 1246		     ffebld_constant_logical2 (ffebld_conter (l)));
 1247		  break;
 1248#endif
 1249
 1250#if FFETARGET_okLOGICAL3
 1251		case FFEINFO_kindtypeLOGICAL3:
 1252		  error = ffetarget_convert_logical1_logical3
 1253		    (ffebld_cu_ptr_logical1 (u),
 1254		     ffebld_constant_logical3 (ffebld_conter (l)));
 1255		  break;
 1256#endif
 1257
 1258#if FFETARGET_okLOGICAL4
 1259		case FFEINFO_kindtypeLOGICAL4:
 1260		  error = ffetarget_convert_logical1_logical4
 1261		    (ffebld_cu_ptr_logical1 (u),
 1262		     ffebld_constant_logical4 (ffebld_conter (l)));
 1263		  break;
 1264#endif
 1265
 1266		default:
 1267		  assert ("LOGICAL1/LOGICAL bad source kind type" == NULL);
 1268		  break;
 1269		}
 1270	      break;
 1271
 1272	    case FFEINFO_basictypeINTEGER:
 1273	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1274		{
 1275#if FFETARGET_okINTEGER1
 1276		case FFEINFO_kindtypeINTEGER1:
 1277		  error = ffetarget_convert_logical1_integer1
 1278		    (ffebld_cu_ptr_logical1 (u),
 1279		     ffebld_constant_integer1 (ffebld_conter (l)));
 1280		  break;
 1281#endif
 1282
 1283#if FFETARGET_okINTEGER2
 1284		case FFEINFO_kindtypeINTEGER2:
 1285		  error = ffetarget_convert_logical1_integer2
 1286		    (ffebld_cu_ptr_logical1 (u),
 1287		     ffebld_constant_integer2 (ffebld_conter (l)));
 1288		  break;
 1289#endif
 1290
 1291#if FFETARGET_okINTEGER3
 1292		case FFEINFO_kindtypeINTEGER3:
 1293		  error = ffetarget_convert_logical1_integer3
 1294		    (ffebld_cu_ptr_logical1 (u),
 1295		     ffebld_constant_integer3 (ffebld_conter (l)));
 1296		  break;
 1297#endif
 1298
 1299#if FFETARGET_okINTEGER4
 1300		case FFEINFO_kindtypeINTEGER4:
 1301		  error = ffetarget_convert_logical1_integer4
 1302		    (ffebld_cu_ptr_logical1 (u),
 1303		     ffebld_constant_integer4 (ffebld_conter (l)));
 1304		  break;
 1305#endif
 1306
 1307		default:
 1308		  assert ("LOGICAL1/INTEGER bad source kind type" == NULL);
 1309		  break;
 1310		}
 1311	      break;
 1312
 1313	    case FFEINFO_basictypeCHARACTER:
 1314	      error = ffetarget_convert_logical1_character1
 1315		(ffebld_cu_ptr_logical1 (u),
 1316		 ffebld_constant_character1 (ffebld_conter (l)));
 1317	      break;
 1318
 1319	    case FFEINFO_basictypeHOLLERITH:
 1320	      error = ffetarget_convert_logical1_hollerith
 1321		(ffebld_cu_ptr_logical1 (u),
 1322		 ffebld_constant_hollerith (ffebld_conter (l)));
 1323	      break;
 1324
 1325	    case FFEINFO_basictypeTYPELESS:
 1326	      error = ffetarget_convert_logical1_typeless
 1327		(ffebld_cu_ptr_logical1 (u),
 1328		 ffebld_constant_typeless (ffebld_conter (l)));
 1329	      break;
 1330
 1331	    default:
 1332	      assert ("LOGICAL1 bad type" == NULL);
 1333	      break;
 1334	    }
 1335
 1336	  /* If conversion operation is not implemented, return original expr.  */
 1337	  if (error == FFEBAD_NOCANDO)
 1338	    return expr;
 1339
 1340	  expr = ffebld_new_conter_with_orig
 1341	    (ffebld_constant_new_logical1_val
 1342	     (ffebld_cu_val_logical1 (u)), expr);
 1343	  break;
 1344#endif
 1345
 1346#if FFETARGET_okLOGICAL2
 1347	case FFEINFO_kindtypeLOGICAL2:
 1348	  switch (ffeinfo_basictype (ffebld_info (l)))
 1349	    {
 1350	    case FFEINFO_basictypeLOGICAL:
 1351	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1352		{
 1353#if FFETARGET_okLOGICAL1
 1354		case FFEINFO_kindtypeLOGICAL1:
 1355		  error = ffetarget_convert_logical2_logical1
 1356		    (ffebld_cu_ptr_logical2 (u),
 1357		     ffebld_constant_logical1 (ffebld_conter (l)));
 1358		  break;
 1359#endif
 1360
 1361#if FFETARGET_okLOGICAL3
 1362		case FFEINFO_kindtypeLOGICAL3:
 1363		  error = ffetarget_convert_logical2_logical3
 1364		    (ffebld_cu_ptr_logical2 (u),
 1365		     ffebld_constant_logical3 (ffebld_conter (l)));
 1366		  break;
 1367#endif
 1368
 1369#if FFETARGET_okLOGICAL4
 1370		case FFEINFO_kindtypeLOGICAL4:
 1371		  error = ffetarget_convert_logical2_logical4
 1372		    (ffebld_cu_ptr_logical2 (u),
 1373		     ffebld_constant_logical4 (ffebld_conter (l)));
 1374		  break;
 1375#endif
 1376
 1377		default:
 1378		  assert ("LOGICAL2/LOGICAL bad source kind type" == NULL);
 1379		  break;
 1380		}
 1381	      break;
 1382
 1383	    case FFEINFO_basictypeINTEGER:
 1384	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1385		{
 1386#if FFETARGET_okINTEGER1
 1387		case FFEINFO_kindtypeINTEGER1:
 1388		  error = ffetarget_convert_logical2_integer1
 1389		    (ffebld_cu_ptr_logical2 (u),
 1390		     ffebld_constant_integer1 (ffebld_conter (l)));
 1391		  break;
 1392#endif
 1393
 1394#if FFETARGET_okINTEGER2
 1395		case FFEINFO_kindtypeINTEGER2:
 1396		  error = ffetarget_convert_logical2_integer2
 1397		    (ffebld_cu_ptr_logical2 (u),
 1398		     ffebld_constant_integer2 (ffebld_conter (l)));
 1399		  break;
 1400#endif
 1401
 1402#if FFETARGET_okINTEGER3
 1403		case FFEINFO_kindtypeINTEGER3:
 1404		  error = ffetarget_convert_logical2_integer3
 1405		    (ffebld_cu_ptr_logical2 (u),
 1406		     ffebld_constant_integer3 (ffebld_conter (l)));
 1407		  break;
 1408#endif
 1409
 1410#if FFETARGET_okINTEGER4
 1411		case FFEINFO_kindtypeINTEGER4:
 1412		  error = ffetarget_convert_logical2_integer4
 1413		    (ffebld_cu_ptr_logical2 (u),
 1414		     ffebld_constant_integer4 (ffebld_conter (l)));
 1415		  break;
 1416#endif
 1417
 1418		default:
 1419		  assert ("LOGICAL2/INTEGER bad source kind type" == NULL);
 1420		  break;
 1421		}
 1422	      break;
 1423
 1424	    case FFEINFO_basictypeCHARACTER:
 1425	      error = ffetarget_convert_logical2_character1
 1426		(ffebld_cu_ptr_logical2 (u),
 1427		 ffebld_constant_character1 (ffebld_conter (l)));
 1428	      break;
 1429
 1430	    case FFEINFO_basictypeHOLLERITH:
 1431	      error = ffetarget_convert_logical2_hollerith
 1432		(ffebld_cu_ptr_logical2 (u),
 1433		 ffebld_constant_hollerith (ffebld_conter (l)));
 1434	      break;
 1435
 1436	    case FFEINFO_basictypeTYPELESS:
 1437	      error = ffetarget_convert_logical2_typeless
 1438		(ffebld_cu_ptr_logical2 (u),
 1439		 ffebld_constant_typeless (ffebld_conter (l)));
 1440	      break;
 1441
 1442	    default:
 1443	      assert ("LOGICAL2 bad type" == NULL);
 1444	      break;
 1445	    }
 1446
 1447	  /* If conversion operation is not implemented, return original expr.  */
 1448	  if (error == FFEBAD_NOCANDO)
 1449	    return expr;
 1450
 1451	  expr = ffebld_new_conter_with_orig
 1452	    (ffebld_constant_new_logical2_val
 1453	     (ffebld_cu_val_logical2 (u)), expr);
 1454	  break;
 1455#endif
 1456
 1457#if FFETARGET_okLOGICAL3
 1458	case FFEINFO_kindtypeLOGICAL3:
 1459	  switch (ffeinfo_basictype (ffebld_info (l)))
 1460	    {
 1461	    case FFEINFO_basictypeLOGICAL:
 1462	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1463		{
 1464#if FFETARGET_okLOGICAL1
 1465		case FFEINFO_kindtypeLOGICAL1:
 1466		  error = ffetarget_convert_logical3_logical1
 1467		    (ffebld_cu_ptr_logical3 (u),
 1468		     ffebld_constant_logical1 (ffebld_conter (l)));
 1469		  break;
 1470#endif
 1471
 1472#if FFETARGET_okLOGICAL2
 1473		case FFEINFO_kindtypeLOGICAL2:
 1474		  error = ffetarget_convert_logical3_logical2
 1475		    (ffebld_cu_ptr_logical3 (u),
 1476		     ffebld_constant_logical2 (ffebld_conter (l)));
 1477		  break;
 1478#endif
 1479
 1480#if FFETARGET_okLOGICAL4
 1481		case FFEINFO_kindtypeLOGICAL4:
 1482		  error = ffetarget_convert_logical3_logical4
 1483		    (ffebld_cu_ptr_logical3 (u),
 1484		     ffebld_constant_logical4 (ffebld_conter (l)));
 1485		  break;
 1486#endif
 1487
 1488		default:
 1489		  assert ("LOGICAL3/LOGICAL bad source kind type" == NULL);
 1490		  break;
 1491		}
 1492	      break;
 1493
 1494	    case FFEINFO_basictypeINTEGER:
 1495	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1496		{
 1497#if FFETARGET_okINTEGER1
 1498		case FFEINFO_kindtypeINTEGER1:
 1499		  error = ffetarget_convert_logical3_integer1
 1500		    (ffebld_cu_ptr_logical3 (u),
 1501		     ffebld_constant_integer1 (ffebld_conter (l)));
 1502		  break;
 1503#endif
 1504
 1505#if FFETARGET_okINTEGER2
 1506		case FFEINFO_kindtypeINTEGER2:
 1507		  error = ffetarget_convert_logical3_integer2
 1508		    (ffebld_cu_ptr_logical3 (u),
 1509		     ffebld_constant_integer2 (ffebld_conter (l)));
 1510		  break;
 1511#endif
 1512
 1513#if FFETARGET_okINTEGER3
 1514		case FFEINFO_kindtypeINTEGER3:
 1515		  error = ffetarget_convert_logical3_integer3
 1516		    (ffebld_cu_ptr_logical3 (u),
 1517		     ffebld_constant_integer3 (ffebld_conter (l)));
 1518		  break;
 1519#endif
 1520
 1521#if FFETARGET_okINTEGER4
 1522		case FFEINFO_kindtypeINTEGER4:
 1523		  error = ffetarget_convert_logical3_integer4
 1524		    (ffebld_cu_ptr_logical3 (u),
 1525		     ffebld_constant_integer4 (ffebld_conter (l)));
 1526		  break;
 1527#endif
 1528
 1529		default:
 1530		  assert ("LOGICAL3/INTEGER bad source kind type" == NULL);
 1531		  break;
 1532		}
 1533	      break;
 1534
 1535	    case FFEINFO_basictypeCHARACTER:
 1536	      error = ffetarget_convert_logical3_character1
 1537		(ffebld_cu_ptr_logical3 (u),
 1538		 ffebld_constant_character1 (ffebld_conter (l)));
 1539	      break;
 1540
 1541	    case FFEINFO_basictypeHOLLERITH:
 1542	      error = ffetarget_convert_logical3_hollerith
 1543		(ffebld_cu_ptr_logical3 (u),
 1544		 ffebld_constant_hollerith (ffebld_conter (l)));
 1545	      break;
 1546
 1547	    case FFEINFO_basictypeTYPELESS:
 1548	      error = ffetarget_convert_logical3_typeless
 1549		(ffebld_cu_ptr_logical3 (u),
 1550		 ffebld_constant_typeless (ffebld_conter (l)));
 1551	      break;
 1552
 1553	    default:
 1554	      assert ("LOGICAL3 bad type" == NULL);
 1555	      break;
 1556	    }
 1557
 1558	  /* If conversion operation is not implemented, return original expr.  */
 1559	  if (error == FFEBAD_NOCANDO)
 1560	    return expr;
 1561
 1562	  expr = ffebld_new_conter_with_orig
 1563	    (ffebld_constant_new_logical3_val
 1564	     (ffebld_cu_val_logical3 (u)), expr);
 1565	  break;
 1566#endif
 1567
 1568#if FFETARGET_okLOGICAL4
 1569	case FFEINFO_kindtypeLOGICAL4:
 1570	  switch (ffeinfo_basictype (ffebld_info (l)))
 1571	    {
 1572	    case FFEINFO_basictypeLOGICAL:
 1573	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1574		{
 1575#if FFETARGET_okLOGICAL1
 1576		case FFEINFO_kindtypeLOGICAL1:
 1577		  error = ffetarget_convert_logical4_logical1
 1578		    (ffebld_cu_ptr_logical4 (u),
 1579		     ffebld_constant_logical1 (ffebld_conter (l)));
 1580		  break;
 1581#endif
 1582
 1583#if FFETARGET_okLOGICAL2
 1584		case FFEINFO_kindtypeLOGICAL2:
 1585		  error = ffetarget_convert_logical4_logical2
 1586		    (ffebld_cu_ptr_logical4 (u),
 1587		     ffebld_constant_logical2 (ffebld_conter (l)));
 1588		  break;
 1589#endif
 1590
 1591#if FFETARGET_okLOGICAL3
 1592		case FFEINFO_kindtypeLOGICAL3:
 1593		  error = ffetarget_convert_logical4_logical3
 1594		    (ffebld_cu_ptr_logical4 (u),
 1595		     ffebld_constant_logical3 (ffebld_conter (l)));
 1596		  break;
 1597#endif
 1598
 1599		default:
 1600		  assert ("LOGICAL4/LOGICAL bad source kind type" == NULL);
 1601		  break;
 1602		}
 1603	      break;
 1604
 1605	    case FFEINFO_basictypeINTEGER:
 1606	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1607		{
 1608#if FFETARGET_okINTEGER1
 1609		case FFEINFO_kindtypeINTEGER1:
 1610		  error = ffetarget_convert_logical4_integer1
 1611		    (ffebld_cu_ptr_logical4 (u),
 1612		     ffebld_constant_integer1 (ffebld_conter (l)));
 1613		  break;
 1614#endif
 1615
 1616#if FFETARGET_okINTEGER2
 1617		case FFEINFO_kindtypeINTEGER2:
 1618		  error = ffetarget_convert_logical4_integer2
 1619		    (ffebld_cu_ptr_logical4 (u),
 1620		     ffebld_constant_integer2 (ffebld_conter (l)));
 1621		  break;
 1622#endif
 1623
 1624#if FFETARGET_okINTEGER3
 1625		case FFEINFO_kindtypeINTEGER3:
 1626		  error = ffetarget_convert_logical4_integer3
 1627		    (ffebld_cu_ptr_logical4 (u),
 1628		     ffebld_constant_integer3 (ffebld_conter (l)));
 1629		  break;
 1630#endif
 1631
 1632#if FFETARGET_okINTEGER4
 1633		case FFEINFO_kindtypeINTEGER4:
 1634		  error = ffetarget_convert_logical4_integer4
 1635		    (ffebld_cu_ptr_logical4 (u),
 1636		     ffebld_constant_integer4 (ffebld_conter (l)));
 1637		  break;
 1638#endif
 1639
 1640		default:
 1641		  assert ("LOGICAL4/INTEGER bad source kind type" == NULL);
 1642		  break;
 1643		}
 1644	      break;
 1645
 1646	    case FFEINFO_basictypeCHARACTER:
 1647	      error = ffetarget_convert_logical4_character1
 1648		(ffebld_cu_ptr_logical4 (u),
 1649		 ffebld_constant_character1 (ffebld_conter (l)));
 1650	      break;
 1651
 1652	    case FFEINFO_basictypeHOLLERITH:
 1653	      error = ffetarget_convert_logical4_hollerith
 1654		(ffebld_cu_ptr_logical4 (u),
 1655		 ffebld_constant_hollerith (ffebld_conter (l)));
 1656	      break;
 1657
 1658	    case FFEINFO_basictypeTYPELESS:
 1659	      error = ffetarget_convert_logical4_typeless
 1660		(ffebld_cu_ptr_logical4 (u),
 1661		 ffebld_constant_typeless (ffebld_conter (l)));
 1662	      break;
 1663
 1664	    default:
 1665	      assert ("LOGICAL4 bad type" == NULL);
 1666	      break;
 1667	    }
 1668
 1669	  /* If conversion operation is not implemented, return original expr.  */
 1670	  if (error == FFEBAD_NOCANDO)
 1671	    return expr;
 1672
 1673	  expr = ffebld_new_conter_with_orig
 1674	    (ffebld_constant_new_logical4_val
 1675	     (ffebld_cu_val_logical4 (u)), expr);
 1676	  break;
 1677#endif
 1678
 1679	default:
 1680	  assert ("bad logical kind type" == NULL);
 1681	  break;
 1682	}
 1683      break;
 1684
 1685    case FFEINFO_basictypeREAL:
 1686      sz = FFETARGET_charactersizeNONE;
 1687      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 1688	{
 1689#if FFETARGET_okREAL1
 1690	case FFEINFO_kindtypeREAL1:
 1691	  switch (ffeinfo_basictype (ffebld_info (l)))
 1692	    {
 1693	    case FFEINFO_basictypeINTEGER:
 1694	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1695		{
 1696#if FFETARGET_okINTEGER1
 1697		case FFEINFO_kindtypeINTEGER1:
 1698		  error = ffetarget_convert_real1_integer1
 1699		    (ffebld_cu_ptr_real1 (u),
 1700		     ffebld_constant_integer1 (ffebld_conter (l)));
 1701		  break;
 1702#endif
 1703
 1704#if FFETARGET_okINTEGER2
 1705		case FFEINFO_kindtypeINTEGER2:
 1706		  error = ffetarget_convert_real1_integer2
 1707		    (ffebld_cu_ptr_real1 (u),
 1708		     ffebld_constant_integer2 (ffebld_conter (l)));
 1709		  break;
 1710#endif
 1711
 1712#if FFETARGET_okINTEGER3
 1713		case FFEINFO_kindtypeINTEGER3:
 1714		  error = ffetarget_convert_real1_integer3
 1715		    (ffebld_cu_ptr_real1 (u),
 1716		     ffebld_constant_integer3 (ffebld_conter (l)));
 1717		  break;
 1718#endif
 1719
 1720#if FFETARGET_okINTEGER4
 1721		case FFEINFO_kindtypeINTEGER4:
 1722		  error = ffetarget_convert_real1_integer4
 1723		    (ffebld_cu_ptr_real1 (u),
 1724		     ffebld_constant_integer4 (ffebld_conter (l)));
 1725		  break;
 1726#endif
 1727
 1728		default:
 1729		  assert ("REAL1/INTEGER bad source kind type" == NULL);
 1730		  break;
 1731		}
 1732	      break;
 1733
 1734	    case FFEINFO_basictypeREAL:
 1735	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1736		{
 1737#if FFETARGET_okREAL2
 1738		case FFEINFO_kindtypeREAL2:
 1739		  error = ffetarget_convert_real1_real2
 1740		    (ffebld_cu_ptr_real1 (u),
 1741		     ffebld_constant_real2 (ffebld_conter (l)));
 1742		  break;
 1743#endif
 1744
 1745#if FFETARGET_okREAL3
 1746		case FFEINFO_kindtypeREAL3:
 1747		  error = ffetarget_convert_real1_real3
 1748		    (ffebld_cu_ptr_real1 (u),
 1749		     ffebld_constant_real3 (ffebld_conter (l)));
 1750		  break;
 1751#endif
 1752
 1753#if FFETARGET_okREAL4
 1754		case FFEINFO_kindtypeREAL4:
 1755		  error = ffetarget_convert_real1_real4
 1756		    (ffebld_cu_ptr_real1 (u),
 1757		     ffebld_constant_real4 (ffebld_conter (l)));
 1758		  break;
 1759#endif
 1760
 1761		default:
 1762		  assert ("REAL1/REAL bad source kind type" == NULL);
 1763		  break;
 1764		}
 1765	      break;
 1766
 1767	    case FFEINFO_basictypeCOMPLEX:
 1768	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1769		{
 1770#if FFETARGET_okCOMPLEX1
 1771		case FFEINFO_kindtypeREAL1:
 1772		  error = ffetarget_convert_real1_complex1
 1773		    (ffebld_cu_ptr_real1 (u),
 1774		     ffebld_constant_complex1 (ffebld_conter (l)));
 1775		  break;
 1776#endif
 1777
 1778#if FFETARGET_okCOMPLEX2
 1779		case FFEINFO_kindtypeREAL2:
 1780		  error = ffetarget_convert_real1_complex2
 1781		    (ffebld_cu_ptr_real1 (u),
 1782		     ffebld_constant_complex2 (ffebld_conter (l)));
 1783		  break;
 1784#endif
 1785
 1786#if FFETARGET_okCOMPLEX3
 1787		case FFEINFO_kindtypeREAL3:
 1788		  error = ffetarget_convert_real1_complex3
 1789		    (ffebld_cu_ptr_real1 (u),
 1790		     ffebld_constant_complex3 (ffebld_conter (l)));
 1791		  break;
 1792#endif
 1793
 1794#if FFETARGET_okCOMPLEX4
 1795		case FFEINFO_kindtypeREAL4:
 1796		  error = ffetarget_convert_real1_complex4
 1797		    (ffebld_cu_ptr_real1 (u),
 1798		     ffebld_constant_complex4 (ffebld_conter (l)));
 1799		  break;
 1800#endif
 1801
 1802		default:
 1803		  assert ("REAL1/COMPLEX bad source kind type" == NULL);
 1804		  break;
 1805		}
 1806	      break;
 1807
 1808	    case FFEINFO_basictypeCHARACTER:
 1809	      error = ffetarget_convert_real1_character1
 1810		(ffebld_cu_ptr_real1 (u),
 1811		 ffebld_constant_character1 (ffebld_conter (l)));
 1812	      break;
 1813
 1814	    case FFEINFO_basictypeHOLLERITH:
 1815	      error = ffetarget_convert_real1_hollerith
 1816		(ffebld_cu_ptr_real1 (u),
 1817		 ffebld_constant_hollerith (ffebld_conter (l)));
 1818	      break;
 1819
 1820	    case FFEINFO_basictypeTYPELESS:
 1821	      error = ffetarget_convert_real1_typeless
 1822		(ffebld_cu_ptr_real1 (u),
 1823		 ffebld_constant_typeless (ffebld_conter (l)));
 1824	      break;
 1825
 1826	    default:
 1827	      assert ("REAL1 bad type" == NULL);
 1828	      break;
 1829	    }
 1830
 1831	  /* If conversion operation is not implemented, return original expr.  */
 1832	  if (error == FFEBAD_NOCANDO)
 1833	    return expr;
 1834
 1835	  expr = ffebld_new_conter_with_orig
 1836	    (ffebld_constant_new_real1_val
 1837	     (ffebld_cu_val_real1 (u)), expr);
 1838	  break;
 1839#endif
 1840
 1841#if FFETARGET_okREAL2
 1842	case FFEINFO_kindtypeREAL2:
 1843	  switch (ffeinfo_basictype (ffebld_info (l)))
 1844	    {
 1845	    case FFEINFO_basictypeINTEGER:
 1846	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1847		{
 1848#if FFETARGET_okINTEGER1
 1849		case FFEINFO_kindtypeINTEGER1:
 1850		  error = ffetarget_convert_real2_integer1
 1851		    (ffebld_cu_ptr_real2 (u),
 1852		     ffebld_constant_integer1 (ffebld_conter (l)));
 1853		  break;
 1854#endif
 1855
 1856#if FFETARGET_okINTEGER2
 1857		case FFEINFO_kindtypeINTEGER2:
 1858		  error = ffetarget_convert_real2_integer2
 1859		    (ffebld_cu_ptr_real2 (u),
 1860		     ffebld_constant_integer2 (ffebld_conter (l)));
 1861		  break;
 1862#endif
 1863
 1864#if FFETARGET_okINTEGER3
 1865		case FFEINFO_kindtypeINTEGER3:
 1866		  error = ffetarget_convert_real2_integer3
 1867		    (ffebld_cu_ptr_real2 (u),
 1868		     ffebld_constant_integer3 (ffebld_conter (l)));
 1869		  break;
 1870#endif
 1871
 1872#if FFETARGET_okINTEGER4
 1873		case FFEINFO_kindtypeINTEGER4:
 1874		  error = ffetarget_convert_real2_integer4
 1875		    (ffebld_cu_ptr_real2 (u),
 1876		     ffebld_constant_integer4 (ffebld_conter (l)));
 1877		  break;
 1878#endif
 1879
 1880		default:
 1881		  assert ("REAL2/INTEGER bad source kind type" == NULL);
 1882		  break;
 1883		}
 1884	      break;
 1885
 1886	    case FFEINFO_basictypeREAL:
 1887	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1888		{
 1889#if FFETARGET_okREAL1
 1890		case FFEINFO_kindtypeREAL1:
 1891		  error = ffetarget_convert_real2_real1
 1892		    (ffebld_cu_ptr_real2 (u),
 1893		     ffebld_constant_real1 (ffebld_conter (l)));
 1894		  break;
 1895#endif
 1896
 1897#if FFETARGET_okREAL3
 1898		case FFEINFO_kindtypeREAL3:
 1899		  error = ffetarget_convert_real2_real3
 1900		    (ffebld_cu_ptr_real2 (u),
 1901		     ffebld_constant_real3 (ffebld_conter (l)));
 1902		  break;
 1903#endif
 1904
 1905#if FFETARGET_okREAL4
 1906		case FFEINFO_kindtypeREAL4:
 1907		  error = ffetarget_convert_real2_real4
 1908		    (ffebld_cu_ptr_real2 (u),
 1909		     ffebld_constant_real4 (ffebld_conter (l)));
 1910		  break;
 1911#endif
 1912
 1913		default:
 1914		  assert ("REAL2/REAL bad source kind type" == NULL);
 1915		  break;
 1916		}
 1917	      break;
 1918
 1919	    case FFEINFO_basictypeCOMPLEX:
 1920	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1921		{
 1922#if FFETARGET_okCOMPLEX1
 1923		case FFEINFO_kindtypeREAL1:
 1924		  error = ffetarget_convert_real2_complex1
 1925		    (ffebld_cu_ptr_real2 (u),
 1926		     ffebld_constant_complex1 (ffebld_conter (l)));
 1927		  break;
 1928#endif
 1929
 1930#if FFETARGET_okCOMPLEX2
 1931		case FFEINFO_kindtypeREAL2:
 1932		  error = ffetarget_convert_real2_complex2
 1933		    (ffebld_cu_ptr_real2 (u),
 1934		     ffebld_constant_complex2 (ffebld_conter (l)));
 1935		  break;
 1936#endif
 1937
 1938#if FFETARGET_okCOMPLEX3
 1939		case FFEINFO_kindtypeREAL3:
 1940		  error = ffetarget_convert_real2_complex3
 1941		    (ffebld_cu_ptr_real2 (u),
 1942		     ffebld_constant_complex3 (ffebld_conter (l)));
 1943		  break;
 1944#endif
 1945
 1946#if FFETARGET_okCOMPLEX4
 1947		case FFEINFO_kindtypeREAL4:
 1948		  error = ffetarget_convert_real2_complex4
 1949		    (ffebld_cu_ptr_real2 (u),
 1950		     ffebld_constant_complex4 (ffebld_conter (l)));
 1951		  break;
 1952#endif
 1953
 1954		default:
 1955		  assert ("REAL2/COMPLEX bad source kind type" == NULL);
 1956		  break;
 1957		}
 1958	      break;
 1959
 1960	    case FFEINFO_basictypeCHARACTER:
 1961	      error = ffetarget_convert_real2_character1
 1962		(ffebld_cu_ptr_real2 (u),
 1963		 ffebld_constant_character1 (ffebld_conter (l)));
 1964	      break;
 1965
 1966	    case FFEINFO_basictypeHOLLERITH:
 1967	      error = ffetarget_convert_real2_hollerith
 1968		(ffebld_cu_ptr_real2 (u),
 1969		 ffebld_constant_hollerith (ffebld_conter (l)));
 1970	      break;
 1971
 1972	    case FFEINFO_basictypeTYPELESS:
 1973	      error = ffetarget_convert_real2_typeless
 1974		(ffebld_cu_ptr_real2 (u),
 1975		 ffebld_constant_typeless (ffebld_conter (l)));
 1976	      break;
 1977
 1978	    default:
 1979	      assert ("REAL2 bad type" == NULL);
 1980	      break;
 1981	    }
 1982
 1983	  /* If conversion operation is not implemented, return original expr.  */
 1984	  if (error == FFEBAD_NOCANDO)
 1985	    return expr;
 1986
 1987	  expr = ffebld_new_conter_with_orig
 1988	    (ffebld_constant_new_real2_val
 1989	     (ffebld_cu_val_real2 (u)), expr);
 1990	  break;
 1991#endif
 1992
 1993#if FFETARGET_okREAL3
 1994	case FFEINFO_kindtypeREAL3:
 1995	  switch (ffeinfo_basictype (ffebld_info (l)))
 1996	    {
 1997	    case FFEINFO_basictypeINTEGER:
 1998	      switch (ffeinfo_kindtype (ffebld_info (l)))
 1999		{
 2000#if FFETARGET_okINTEGER1
 2001		case FFEINFO_kindtypeINTEGER1:
 2002		  error = ffetarget_convert_real3_integer1
 2003		    (ffebld_cu_ptr_real3 (u),
 2004		     ffebld_constant_integer1 (ffebld_conter (l)));
 2005		  break;
 2006#endif
 2007
 2008#if FFETARGET_okINTEGER2
 2009		case FFEINFO_kindtypeINTEGER2:
 2010		  error = ffetarget_convert_real3_integer2
 2011		    (ffebld_cu_ptr_real3 (u),
 2012		     ffebld_constant_integer2 (ffebld_conter (l)));
 2013		  break;
 2014#endif
 2015
 2016#if FFETARGET_okINTEGER3
 2017		case FFEINFO_kindtypeINTEGER3:
 2018		  error = ffetarget_convert_real3_integer3
 2019		    (ffebld_cu_ptr_real3 (u),
 2020		     ffebld_constant_integer3 (ffebld_conter (l)));
 2021		  break;
 2022#endif
 2023
 2024#if FFETARGET_okINTEGER4
 2025		case FFEINFO_kindtypeINTEGER4:
 2026		  error = ffetarget_convert_real3_integer4
 2027		    (ffebld_cu_ptr_real3 (u),
 2028		     ffebld_constant_integer4 (ffebld_conter (l)));
 2029		  break;
 2030#endif
 2031
 2032		default:
 2033		  assert ("REAL3/INTEGER bad source kind type" == NULL);
 2034		  break;
 2035		}
 2036	      break;
 2037
 2038	    case FFEINFO_basictypeREAL:
 2039	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2040		{
 2041#if FFETARGET_okREAL1
 2042		case FFEINFO_kindtypeREAL1:
 2043		  error = ffetarget_convert_real3_real1
 2044		    (ffebld_cu_ptr_real3 (u),
 2045		     ffebld_constant_real1 (ffebld_conter (l)));
 2046		  break;
 2047#endif
 2048
 2049#if FFETARGET_okREAL2
 2050		case FFEINFO_kindtypeREAL2:
 2051		  error = ffetarget_convert_real3_real2
 2052		    (ffebld_cu_ptr_real3 (u),
 2053		     ffebld_constant_real2 (ffebld_conter (l)));
 2054		  break;
 2055#endif
 2056
 2057#if FFETARGET_okREAL4
 2058		case FFEINFO_kindtypeREAL4:
 2059		  error = ffetarget_convert_real3_real4
 2060		    (ffebld_cu_ptr_real3 (u),
 2061		     ffebld_constant_real4 (ffebld_conter (l)));
 2062		  break;
 2063#endif
 2064
 2065		default:
 2066		  assert ("REAL3/REAL bad source kind type" == NULL);
 2067		  break;
 2068		}
 2069	      break;
 2070
 2071	    case FFEINFO_basictypeCOMPLEX:
 2072	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2073		{
 2074#if FFETARGET_okCOMPLEX1
 2075		case FFEINFO_kindtypeREAL1:
 2076		  error = ffetarget_convert_real3_complex1
 2077		    (ffebld_cu_ptr_real3 (u),
 2078		     ffebld_constant_complex1 (ffebld_conter (l)));
 2079		  break;
 2080#endif
 2081
 2082#if FFETARGET_okCOMPLEX2
 2083		case FFEINFO_kindtypeREAL2:
 2084		  error = ffetarget_convert_real3_complex2
 2085		    (ffebld_cu_ptr_real3 (u),
 2086		     ffebld_constant_complex2 (ffebld_conter (l)));
 2087		  break;
 2088#endif
 2089
 2090#if FFETARGET_okCOMPLEX3
 2091		case FFEINFO_kindtypeREAL3:
 2092		  error = ffetarget_convert_real3_complex3
 2093		    (ffebld_cu_ptr_real3 (u),
 2094		     ffebld_constant_complex3 (ffebld_conter (l)));
 2095		  break;
 2096#endif
 2097
 2098#if FFETARGET_okCOMPLEX4
 2099		case FFEINFO_kindtypeREAL4:
 2100		  error = ffetarget_convert_real3_complex4
 2101		    (ffebld_cu_ptr_real3 (u),
 2102		     ffebld_constant_complex4 (ffebld_conter (l)));
 2103		  break;
 2104#endif
 2105
 2106		default:
 2107		  assert ("REAL3/COMPLEX bad source kind type" == NULL);
 2108		  break;
 2109		}
 2110	      break;
 2111
 2112	    case FFEINFO_basictypeCHARACTER:
 2113	      error = ffetarget_convert_real3_character1
 2114		(ffebld_cu_ptr_real3 (u),
 2115		 ffebld_constant_character1 (ffebld_conter (l)));
 2116	      break;
 2117
 2118	    case FFEINFO_basictypeHOLLERITH:
 2119	      error = ffetarget_convert_real3_hollerith
 2120		(ffebld_cu_ptr_real3 (u),
 2121		 ffebld_constant_hollerith (ffebld_conter (l)));
 2122	      break;
 2123
 2124	    case FFEINFO_basictypeTYPELESS:
 2125	      error = ffetarget_convert_real3_typeless
 2126		(ffebld_cu_ptr_real3 (u),
 2127		 ffebld_constant_typeless (ffebld_conter (l)));
 2128	      break;
 2129
 2130	    default:
 2131	      assert ("REAL3 bad type" == NULL);
 2132	      break;
 2133	    }
 2134
 2135	  /* If conversion operation is not implemented, return original expr.  */
 2136	  if (error == FFEBAD_NOCANDO)
 2137	    return expr;
 2138
 2139	  expr = ffebld_new_conter_with_orig
 2140	    (ffebld_constant_new_real3_val
 2141	     (ffebld_cu_val_real3 (u)), expr);
 2142	  break;
 2143#endif
 2144
 2145#if FFETARGET_okREAL4
 2146	case FFEINFO_kindtypeREAL4:
 2147	  switch (ffeinfo_basictype (ffebld_info (l)))
 2148	    {
 2149	    case FFEINFO_basictypeINTEGER:
 2150	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2151		{
 2152#if FFETARGET_okINTEGER1
 2153		case FFEINFO_kindtypeINTEGER1:
 2154		  error = ffetarget_convert_real4_integer1
 2155		    (ffebld_cu_ptr_real4 (u),
 2156		     ffebld_constant_integer1 (ffebld_conter (l)));
 2157		  break;
 2158#endif
 2159
 2160#if FFETARGET_okINTEGER2
 2161		case FFEINFO_kindtypeINTEGER2:
 2162		  error = ffetarget_convert_real4_integer2
 2163		    (ffebld_cu_ptr_real4 (u),
 2164		     ffebld_constant_integer2 (ffebld_conter (l)));
 2165		  break;
 2166#endif
 2167
 2168#if FFETARGET_okINTEGER3
 2169		case FFEINFO_kindtypeINTEGER3:
 2170		  error = ffetarget_convert_real4_integer3
 2171		    (ffebld_cu_ptr_real4 (u),
 2172		     ffebld_constant_integer3 (ffebld_conter (l)));
 2173		  break;
 2174#endif
 2175
 2176#if FFETARGET_okINTEGER4
 2177		case FFEINFO_kindtypeINTEGER4:
 2178		  error = ffetarget_convert_real4_integer4
 2179		    (ffebld_cu_ptr_real4 (u),
 2180		     ffebld_constant_integer4 (ffebld_conter (l)));
 2181		  break;
 2182#endif
 2183
 2184		default:
 2185		  assert ("REAL4/INTEGER bad source kind type" == NULL);
 2186		  break;
 2187		}
 2188	      break;
 2189
 2190	    case FFEINFO_basictypeREAL:
 2191	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2192		{
 2193#if FFETARGET_okREAL1
 2194		case FFEINFO_kindtypeREAL1:
 2195		  error = ffetarget_convert_real4_real1
 2196		    (ffebld_cu_ptr_real4 (u),
 2197		     ffebld_constant_real1 (ffebld_conter (l)));
 2198		  break;
 2199#endif
 2200
 2201#if FFETARGET_okREAL2
 2202		case FFEINFO_kindtypeREAL2:
 2203		  error = ffetarget_convert_real4_real2
 2204		    (ffebld_cu_ptr_real4 (u),
 2205		     ffebld_constant_real2 (ffebld_conter (l)));
 2206		  break;
 2207#endif
 2208
 2209#if FFETARGET_okREAL3
 2210		case FFEINFO_kindtypeREAL3:
 2211		  error = ffetarget_convert_real4_real3
 2212		    (ffebld_cu_ptr_real4 (u),
 2213		     ffebld_constant_real3 (ffebld_conter (l)));
 2214		  break;
 2215#endif
 2216
 2217		default:
 2218		  assert ("REAL4/REAL bad source kind type" == NULL);
 2219		  break;
 2220		}
 2221	      break;
 2222
 2223	    case FFEINFO_basictypeCOMPLEX:
 2224	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2225		{
 2226#if FFETARGET_okCOMPLEX1
 2227		case FFEINFO_kindtypeREAL1:
 2228		  error = ffetarget_convert_real4_complex1
 2229		    (ffebld_cu_ptr_real4 (u),
 2230		     ffebld_constant_complex1 (ffebld_conter (l)));
 2231		  break;
 2232#endif
 2233
 2234#if FFETARGET_okCOMPLEX2
 2235		case FFEINFO_kindtypeREAL2:
 2236		  error = ffetarget_convert_real4_complex2
 2237		    (ffebld_cu_ptr_real4 (u),
 2238		     ffebld_constant_complex2 (ffebld_conter (l)));
 2239		  break;
 2240#endif
 2241
 2242#if FFETARGET_okCOMPLEX3
 2243		case FFEINFO_kindtypeREAL3:
 2244		  error = ffetarget_convert_real4_complex3
 2245		    (ffebld_cu_ptr_real4 (u),
 2246		     ffebld_constant_complex3 (ffebld_conter (l)));
 2247		  break;
 2248#endif
 2249
 2250#if FFETARGET_okCOMPLEX4
 2251		case FFEINFO_kindtypeREAL4:
 2252		  error = ffetarget_convert_real4_complex4
 2253		    (ffebld_cu_ptr_real4 (u),
 2254		     ffebld_constant_complex4 (ffebld_conter (l)));
 2255		  break;
 2256#endif
 2257
 2258		default:
 2259		  assert ("REAL4/COMPLEX bad source kind type" == NULL);
 2260		  break;
 2261		}
 2262	      break;
 2263
 2264	    case FFEINFO_basictypeCHARACTER:
 2265	      error = ffetarget_convert_real4_character1
 2266		(ffebld_cu_ptr_real4 (u),
 2267		 ffebld_constant_character1 (ffebld_conter (l)));
 2268	      break;
 2269
 2270	    case FFEINFO_basictypeHOLLERITH:
 2271	      error = ffetarget_convert_real4_hollerith
 2272		(ffebld_cu_ptr_real4 (u),
 2273		 ffebld_constant_hollerith (ffebld_conter (l)));
 2274	      break;
 2275
 2276	    case FFEINFO_basictypeTYPELESS:
 2277	      error = ffetarget_convert_real4_typeless
 2278		(ffebld_cu_ptr_real4 (u),
 2279		 ffebld_constant_typeless (ffebld_conter (l)));
 2280	      break;
 2281
 2282	    default:
 2283	      assert ("REAL4 bad type" == NULL);
 2284	      break;
 2285	    }
 2286
 2287	  /* If conversion operation is not implemented, return original expr.  */
 2288	  if (error == FFEBAD_NOCANDO)
 2289	    return expr;
 2290
 2291	  expr = ffebld_new_conter_with_orig
 2292	    (ffebld_constant_new_real4_val
 2293	     (ffebld_cu_val_real4 (u)), expr);
 2294	  break;
 2295#endif
 2296
 2297	default:
 2298	  assert ("bad real kind type" == NULL);
 2299	  break;
 2300	}
 2301      break;
 2302
 2303    case FFEINFO_basictypeCOMPLEX:
 2304      sz = FFETARGET_charactersizeNONE;
 2305      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 2306	{
 2307#if FFETARGET_okCOMPLEX1
 2308	case FFEINFO_kindtypeREAL1:
 2309	  switch (ffeinfo_basictype (ffebld_info (l)))
 2310	    {
 2311	    case FFEINFO_basictypeINTEGER:
 2312	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2313		{
 2314#if FFETARGET_okINTEGER1
 2315		case FFEINFO_kindtypeINTEGER1:
 2316		  error = ffetarget_convert_complex1_integer1
 2317		    (ffebld_cu_ptr_complex1 (u),
 2318		     ffebld_constant_integer1 (ffebld_conter (l)));
 2319		  break;
 2320#endif
 2321
 2322#if FFETARGET_okINTEGER2
 2323		case FFEINFO_kindtypeINTEGER2:
 2324		  error = ffetarget_convert_complex1_integer2
 2325		    (ffebld_cu_ptr_complex1 (u),
 2326		     ffebld_constant_integer2 (ffebld_conter (l)));
 2327		  break;
 2328#endif
 2329
 2330#if FFETARGET_okINTEGER3
 2331		case FFEINFO_kindtypeINTEGER3:
 2332		  error = ffetarget_convert_complex1_integer3
 2333		    (ffebld_cu_ptr_complex1 (u),
 2334		     ffebld_constant_integer3 (ffebld_conter (l)));
 2335		  break;
 2336#endif
 2337
 2338#if FFETARGET_okINTEGER4
 2339		case FFEINFO_kindtypeINTEGER4:
 2340		  error = ffetarget_convert_complex1_integer4
 2341		    (ffebld_cu_ptr_complex1 (u),
 2342		     ffebld_constant_integer4 (ffebld_conter (l)));
 2343		  break;
 2344#endif
 2345
 2346		default:
 2347		  assert ("COMPLEX1/INTEGER bad source kind type" == NULL);
 2348		  break;
 2349		}
 2350	      break;
 2351
 2352	    case FFEINFO_basictypeREAL:
 2353	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2354		{
 2355#if FFETARGET_okREAL1
 2356		case FFEINFO_kindtypeREAL1:
 2357		  error = ffetarget_convert_complex1_real1
 2358		    (ffebld_cu_ptr_complex1 (u),
 2359		     ffebld_constant_real1 (ffebld_conter (l)));
 2360		  break;
 2361#endif
 2362
 2363#if FFETARGET_okREAL2
 2364		case FFEINFO_kindtypeREAL2:
 2365		  error = ffetarget_convert_complex1_real2
 2366		    (ffebld_cu_ptr_complex1 (u),
 2367		     ffebld_constant_real2 (ffebld_conter (l)));
 2368		  break;
 2369#endif
 2370
 2371#if FFETARGET_okREAL3
 2372		case FFEINFO_kindtypeREAL3:
 2373		  error = ffetarget_convert_complex1_real3
 2374		    (ffebld_cu_ptr_complex1 (u),
 2375		     ffebld_constant_real3 (ffebld_conter (l)));
 2376		  break;
 2377#endif
 2378
 2379#if FFETARGET_okREAL4
 2380		case FFEINFO_kindtypeREAL4:
 2381		  error = ffetarget_convert_complex1_real4
 2382		    (ffebld_cu_ptr_complex1 (u),
 2383		     ffebld_constant_real4 (ffebld_conter (l)));
 2384		  break;
 2385#endif
 2386
 2387		default:
 2388		  assert ("COMPLEX1/REAL bad source kind type" == NULL);
 2389		  break;
 2390		}
 2391	      break;
 2392
 2393	    case FFEINFO_basictypeCOMPLEX:
 2394	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2395		{
 2396#if FFETARGET_okCOMPLEX2
 2397		case FFEINFO_kindtypeREAL2:
 2398		  error = ffetarget_convert_complex1_complex2
 2399		    (ffebld_cu_ptr_complex1 (u),
 2400		     ffebld_constant_complex2 (ffebld_conter (l)));
 2401		  break;
 2402#endif
 2403
 2404#if FFETARGET_okCOMPLEX3
 2405		case FFEINFO_kindtypeREAL3:
 2406		  error = ffetarget_convert_complex1_complex3
 2407		    (ffebld_cu_ptr_complex1 (u),
 2408		     ffebld_constant_complex3 (ffebld_conter (l)));
 2409		  break;
 2410#endif
 2411
 2412#if FFETARGET_okCOMPLEX4
 2413		case FFEINFO_kindtypeREAL4:
 2414		  error = ffetarget_convert_complex1_complex4
 2415		    (ffebld_cu_ptr_complex1 (u),
 2416		     ffebld_constant_complex4 (ffebld_conter (l)));
 2417		  break;
 2418#endif
 2419
 2420		default:
 2421		  assert ("COMPLEX1/COMPLEX bad source kind type" == NULL);
 2422		  break;
 2423		}
 2424	      break;
 2425
 2426	    case FFEINFO_basictypeCHARACTER:
 2427	      error = ffetarget_convert_complex1_character1
 2428		(ffebld_cu_ptr_complex1 (u),
 2429		 ffebld_constant_character1 (ffebld_conter (l)));
 2430	      break;
 2431
 2432	    case FFEINFO_basictypeHOLLERITH:
 2433	      error = ffetarget_convert_complex1_hollerith
 2434		(ffebld_cu_ptr_complex1 (u),
 2435		 ffebld_constant_hollerith (ffebld_conter (l)));
 2436	      break;
 2437
 2438	    case FFEINFO_basictypeTYPELESS:
 2439	      error = ffetarget_convert_complex1_typeless
 2440		(ffebld_cu_ptr_complex1 (u),
 2441		 ffebld_constant_typeless (ffebld_conter (l)));
 2442	      break;
 2443
 2444	    default:
 2445	      assert ("COMPLEX1 bad type" == NULL);
 2446	      break;
 2447	    }
 2448
 2449	  /* If conversion operation is not implemented, return original expr.  */
 2450	  if (error == FFEBAD_NOCANDO)
 2451	    return expr;
 2452
 2453	  expr = ffebld_new_conter_with_orig
 2454	    (ffebld_constant_new_complex1_val
 2455	     (ffebld_cu_val_complex1 (u)), expr);
 2456	  break;
 2457#endif
 2458
 2459#if FFETARGET_okCOMPLEX2
 2460	case FFEINFO_kindtypeREAL2:
 2461	  switch (ffeinfo_basictype (ffebld_info (l)))
 2462	    {
 2463	    case FFEINFO_basictypeINTEGER:
 2464	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2465		{
 2466#if FFETARGET_okINTEGER1
 2467		case FFEINFO_kindtypeINTEGER1:
 2468		  error = ffetarget_convert_complex2_integer1
 2469		    (ffebld_cu_ptr_complex2 (u),
 2470		     ffebld_constant_integer1 (ffebld_conter (l)));
 2471		  break;
 2472#endif
 2473
 2474#if FFETARGET_okINTEGER2
 2475		case FFEINFO_kindtypeINTEGER2:
 2476		  error = ffetarget_convert_complex2_integer2
 2477		    (ffebld_cu_ptr_complex2 (u),
 2478		     ffebld_constant_integer2 (ffebld_conter (l)));
 2479		  break;
 2480#endif
 2481
 2482#if FFETARGET_okINTEGER3
 2483		case FFEINFO_kindtypeINTEGER3:
 2484		  error = ffetarget_convert_complex2_integer3
 2485		    (ffebld_cu_ptr_complex2 (u),
 2486		     ffebld_constant_integer3 (ffebld_conter (l)));
 2487		  break;
 2488#endif
 2489
 2490#if FFETARGET_okINTEGER4
 2491		case FFEINFO_kindtypeINTEGER4:
 2492		  error = ffetarget_convert_complex2_integer4
 2493		    (ffebld_cu_ptr_complex2 (u),
 2494		     ffebld_constant_integer4 (ffebld_conter (l)));
 2495		  break;
 2496#endif
 2497
 2498		default:
 2499		  assert ("COMPLEX2/INTEGER bad source kind type" == NULL);
 2500		  break;
 2501		}
 2502	      break;
 2503
 2504	    case FFEINFO_basictypeREAL:
 2505	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2506		{
 2507#if FFETARGET_okREAL1
 2508		case FFEINFO_kindtypeREAL1:
 2509		  error = ffetarget_convert_complex2_real1
 2510		    (ffebld_cu_ptr_complex2 (u),
 2511		     ffebld_constant_real1 (ffebld_conter (l)));
 2512		  break;
 2513#endif
 2514
 2515#if FFETARGET_okREAL2
 2516		case FFEINFO_kindtypeREAL2:
 2517		  error = ffetarget_convert_complex2_real2
 2518		    (ffebld_cu_ptr_complex2 (u),
 2519		     ffebld_constant_real2 (ffebld_conter (l)));
 2520		  break;
 2521#endif
 2522
 2523#if FFETARGET_okREAL3
 2524		case FFEINFO_kindtypeREAL3:
 2525		  error = ffetarget_convert_complex2_real3
 2526		    (ffebld_cu_ptr_complex2 (u),
 2527		     ffebld_constant_real3 (ffebld_conter (l)));
 2528		  break;
 2529#endif
 2530
 2531#if FFETARGET_okREAL4
 2532		case FFEINFO_kindtypeREAL4:
 2533		  error = ffetarget_convert_complex2_real4
 2534		    (ffebld_cu_ptr_complex2 (u),
 2535		     ffebld_constant_real4 (ffebld_conter (l)));
 2536		  break;
 2537#endif
 2538
 2539		default:
 2540		  assert ("COMPLEX2/REAL bad source kind type" == NULL);
 2541		  break;
 2542		}
 2543	      break;
 2544
 2545	    case FFEINFO_basictypeCOMPLEX:
 2546	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2547		{
 2548#if FFETARGET_okCOMPLEX1
 2549		case FFEINFO_kindtypeREAL1:
 2550		  error = ffetarget_convert_complex2_complex1
 2551		    (ffebld_cu_ptr_complex2 (u),
 2552		     ffebld_constant_complex1 (ffebld_conter (l)));
 2553		  break;
 2554#endif
 2555
 2556#if FFETARGET_okCOMPLEX3
 2557		case FFEINFO_kindtypeREAL3:
 2558		  error = ffetarget_convert_complex2_complex3
 2559		    (ffebld_cu_ptr_complex2 (u),
 2560		     ffebld_constant_complex3 (ffebld_conter (l)));
 2561		  break;
 2562#endif
 2563
 2564#if FFETARGET_okCOMPLEX4
 2565		case FFEINFO_kindtypeREAL4:
 2566		  error = ffetarget_convert_complex2_complex4
 2567		    (ffebld_cu_ptr_complex2 (u),
 2568		     ffebld_constant_complex4 (ffebld_conter (l)));
 2569		  break;
 2570#endif
 2571
 2572		default:
 2573		  assert ("COMPLEX2/COMPLEX bad source kind type" == NULL);
 2574		  break;
 2575		}
 2576	      break;
 2577
 2578	    case FFEINFO_basictypeCHARACTER:
 2579	      error = ffetarget_convert_complex2_character1
 2580		(ffebld_cu_ptr_complex2 (u),
 2581		 ffebld_constant_character1 (ffebld_conter (l)));
 2582	      break;
 2583
 2584	    case FFEINFO_basictypeHOLLERITH:
 2585	      error = ffetarget_convert_complex2_hollerith
 2586		(ffebld_cu_ptr_complex2 (u),
 2587		 ffebld_constant_hollerith (ffebld_conter (l)));
 2588	      break;
 2589
 2590	    case FFEINFO_basictypeTYPELESS:
 2591	      error = ffetarget_convert_complex2_typeless
 2592		(ffebld_cu_ptr_complex2 (u),
 2593		 ffebld_constant_typeless (ffebld_conter (l)));
 2594	      break;
 2595
 2596	    default:
 2597	      assert ("COMPLEX2 bad type" == NULL);
 2598	      break;
 2599	    }
 2600
 2601	  /* If conversion operation is not implemented, return original expr.  */
 2602	  if (error == FFEBAD_NOCANDO)
 2603	    return expr;
 2604
 2605	  expr = ffebld_new_conter_with_orig
 2606	    (ffebld_constant_new_complex2_val
 2607	     (ffebld_cu_val_complex2 (u)), expr);
 2608	  break;
 2609#endif
 2610
 2611#if FFETARGET_okCOMPLEX3
 2612	case FFEINFO_kindtypeREAL3:
 2613	  switch (ffeinfo_basictype (ffebld_info (l)))
 2614	    {
 2615	    case FFEINFO_basictypeINTEGER:
 2616	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2617		{
 2618#if FFETARGET_okINTEGER1
 2619		case FFEINFO_kindtypeINTEGER1:
 2620		  error = ffetarget_convert_complex3_integer1
 2621		    (ffebld_cu_ptr_complex3 (u),
 2622		     ffebld_constant_integer1 (ffebld_conter (l)));
 2623		  break;
 2624#endif
 2625
 2626#if FFETARGET_okINTEGER2
 2627		case FFEINFO_kindtypeINTEGER2:
 2628		  error = ffetarget_convert_complex3_integer2
 2629		    (ffebld_cu_ptr_complex3 (u),
 2630		     ffebld_constant_integer2 (ffebld_conter (l)));
 2631		  break;
 2632#endif
 2633
 2634#if FFETARGET_okINTEGER3
 2635		case FFEINFO_kindtypeINTEGER3:
 2636		  error = ffetarget_convert_complex3_integer3
 2637		    (ffebld_cu_ptr_complex3 (u),
 2638		     ffebld_constant_integer3 (ffebld_conter (l)));
 2639		  break;
 2640#endif
 2641
 2642#if FFETARGET_okINTEGER4
 2643		case FFEINFO_kindtypeINTEGER4:
 2644		  error = ffetarget_convert_complex3_integer4
 2645		    (ffebld_cu_ptr_complex3 (u),
 2646		     ffebld_constant_integer4 (ffebld_conter (l)));
 2647		  break;
 2648#endif
 2649
 2650		default:
 2651		  assert ("COMPLEX3/INTEGER bad source kind type" == NULL);
 2652		  break;
 2653		}
 2654	      break;
 2655
 2656	    case FFEINFO_basictypeREAL:
 2657	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2658		{
 2659#if FFETARGET_okREAL1
 2660		case FFEINFO_kindtypeREAL1:
 2661		  error = ffetarget_convert_complex3_real1
 2662		    (ffebld_cu_ptr_complex3 (u),
 2663		     ffebld_constant_real1 (ffebld_conter (l)));
 2664		  break;
 2665#endif
 2666
 2667#if FFETARGET_okREAL2
 2668		case FFEINFO_kindtypeREAL2:
 2669		  error = ffetarget_convert_complex3_real2
 2670		    (ffebld_cu_ptr_complex3 (u),
 2671		     ffebld_constant_real2 (ffebld_conter (l)));
 2672		  break;
 2673#endif
 2674
 2675#if FFETARGET_okREAL3
 2676		case FFEINFO_kindtypeREAL3:
 2677		  error = ffetarget_convert_complex3_real3
 2678		    (ffebld_cu_ptr_complex3 (u),
 2679		     ffebld_constant_real3 (ffebld_conter (l)));
 2680		  break;
 2681#endif
 2682
 2683#if FFETARGET_okREAL4
 2684		case FFEINFO_kindtypeREAL4:
 2685		  error = ffetarget_convert_complex3_real4
 2686		    (ffebld_cu_ptr_complex3 (u),
 2687		     ffebld_constant_real4 (ffebld_conter (l)));
 2688		  break;
 2689#endif
 2690
 2691		default:
 2692		  assert ("COMPLEX3/REAL bad source kind type" == NULL);
 2693		  break;
 2694		}
 2695	      break;
 2696
 2697	    case FFEINFO_basictypeCOMPLEX:
 2698	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2699		{
 2700#if FFETARGET_okCOMPLEX1
 2701		case FFEINFO_kindtypeREAL1:
 2702		  error = ffetarget_convert_complex3_complex1
 2703		    (ffebld_cu_ptr_complex3 (u),
 2704		     ffebld_constant_complex1 (ffebld_conter (l)));
 2705		  break;
 2706#endif
 2707
 2708#if FFETARGET_okCOMPLEX2
 2709		case FFEINFO_kindtypeREAL2:
 2710		  error = ffetarget_convert_complex3_complex2
 2711		    (ffebld_cu_ptr_complex3 (u),
 2712		     ffebld_constant_complex2 (ffebld_conter (l)));
 2713		  break;
 2714#endif
 2715
 2716#if FFETARGET_okCOMPLEX4
 2717		case FFEINFO_kindtypeREAL4:
 2718		  error = ffetarget_convert_complex3_complex4
 2719		    (ffebld_cu_ptr_complex3 (u),
 2720		     ffebld_constant_complex4 (ffebld_conter (l)));
 2721		  break;
 2722#endif
 2723
 2724		default:
 2725		  assert ("COMPLEX3/COMPLEX bad source kind type" == NULL);
 2726		  break;
 2727		}
 2728	      break;
 2729
 2730	    case FFEINFO_basictypeCHARACTER:
 2731	      error = ffetarget_convert_complex3_character1
 2732		(ffebld_cu_ptr_complex3 (u),
 2733		 ffebld_constant_character1 (ffebld_conter (l)));
 2734	      break;
 2735
 2736	    case FFEINFO_basictypeHOLLERITH:
 2737	      error = ffetarget_convert_complex3_hollerith
 2738		(ffebld_cu_ptr_complex3 (u),
 2739		 ffebld_constant_hollerith (ffebld_conter (l)));
 2740	      break;
 2741
 2742	    case FFEINFO_basictypeTYPELESS:
 2743	      error = ffetarget_convert_complex3_typeless
 2744		(ffebld_cu_ptr_complex3 (u),
 2745		 ffebld_constant_typeless (ffebld_conter (l)));
 2746	      break;
 2747
 2748	    default:
 2749	      assert ("COMPLEX3 bad type" == NULL);
 2750	      break;
 2751	    }
 2752
 2753	  /* If conversion operation is not implemented, return original expr.  */
 2754	  if (error == FFEBAD_NOCANDO)
 2755	    return expr;
 2756
 2757	  expr = ffebld_new_conter_with_orig
 2758	    (ffebld_constant_new_complex3_val
 2759	     (ffebld_cu_val_complex3 (u)), expr);
 2760	  break;
 2761#endif
 2762
 2763#if FFETARGET_okCOMPLEX4
 2764	case FFEINFO_kindtypeREAL4:
 2765	  switch (ffeinfo_basictype (ffebld_info (l)))
 2766	    {
 2767	    case FFEINFO_basictypeINTEGER:
 2768	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2769		{
 2770#if FFETARGET_okINTEGER1
 2771		case FFEINFO_kindtypeINTEGER1:
 2772		  error = ffetarget_convert_complex4_integer1
 2773		    (ffebld_cu_ptr_complex4 (u),
 2774		     ffebld_constant_integer1 (ffebld_conter (l)));
 2775		  break;
 2776#endif
 2777
 2778#if FFETARGET_okINTEGER2
 2779		case FFEINFO_kindtypeINTEGER2:
 2780		  error = ffetarget_convert_complex4_integer2
 2781		    (ffebld_cu_ptr_complex4 (u),
 2782		     ffebld_constant_integer2 (ffebld_conter (l)));
 2783		  break;
 2784#endif
 2785
 2786#if FFETARGET_okINTEGER3
 2787		case FFEINFO_kindtypeINTEGER3:
 2788		  error = ffetarget_convert_complex4_integer3
 2789		    (ffebld_cu_ptr_complex4 (u),
 2790		     ffebld_constant_integer3 (ffebld_conter (l)));
 2791		  break;
 2792#endif
 2793
 2794#if FFETARGET_okINTEGER4
 2795		case FFEINFO_kindtypeINTEGER4:
 2796		  error = ffetarget_convert_complex4_integer4
 2797		    (ffebld_cu_ptr_complex4 (u),
 2798		     ffebld_constant_integer4 (ffebld_conter (l)));
 2799		  break;
 2800#endif
 2801
 2802		default:
 2803		  assert ("COMPLEX4/INTEGER bad source kind type" == NULL);
 2804		  break;
 2805		}
 2806	      break;
 2807
 2808	    case FFEINFO_basictypeREAL:
 2809	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2810		{
 2811#if FFETARGET_okREAL1
 2812		case FFEINFO_kindtypeREAL1:
 2813		  error = ffetarget_convert_complex4_real1
 2814		    (ffebld_cu_ptr_complex4 (u),
 2815		     ffebld_constant_real1 (ffebld_conter (l)));
 2816		  break;
 2817#endif
 2818
 2819#if FFETARGET_okREAL2
 2820		case FFEINFO_kindtypeREAL2:
 2821		  error = ffetarget_convert_complex4_real2
 2822		    (ffebld_cu_ptr_complex4 (u),
 2823		     ffebld_constant_real2 (ffebld_conter (l)));
 2824		  break;
 2825#endif
 2826
 2827#if FFETARGET_okREAL3
 2828		case FFEINFO_kindtypeREAL3:
 2829		  error = ffetarget_convert_complex4_real3
 2830		    (ffebld_cu_ptr_complex4 (u),
 2831		     ffebld_constant_real3 (ffebld_conter (l)));
 2832		  break;
 2833#endif
 2834
 2835#if FFETARGET_okREAL4
 2836		case FFEINFO_kindtypeREAL4:
 2837		  error = ffetarget_convert_complex4_real4
 2838		    (ffebld_cu_ptr_complex4 (u),
 2839		     ffebld_constant_real4 (ffebld_conter (l)));
 2840		  break;
 2841#endif
 2842
 2843		default:
 2844		  assert ("COMPLEX4/REAL bad source kind type" == NULL);
 2845		  break;
 2846		}
 2847	      break;
 2848
 2849	    case FFEINFO_basictypeCOMPLEX:
 2850	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2851		{
 2852#if FFETARGET_okCOMPLEX1
 2853		case FFEINFO_kindtypeREAL1:
 2854		  error = ffetarget_convert_complex4_complex1
 2855		    (ffebld_cu_ptr_complex4 (u),
 2856		     ffebld_constant_complex1 (ffebld_conter (l)));
 2857		  break;
 2858#endif
 2859
 2860#if FFETARGET_okCOMPLEX2
 2861		case FFEINFO_kindtypeREAL2:
 2862		  error = ffetarget_convert_complex4_complex2
 2863		    (ffebld_cu_ptr_complex4 (u),
 2864		     ffebld_constant_complex2 (ffebld_conter (l)));
 2865		  break;
 2866#endif
 2867
 2868#if FFETARGET_okCOMPLEX3
 2869		case FFEINFO_kindtypeREAL3:
 2870		  error = ffetarget_convert_complex4_complex3
 2871		    (ffebld_cu_ptr_complex4 (u),
 2872		     ffebld_constant_complex3 (ffebld_conter (l)));
 2873		  break;
 2874#endif
 2875
 2876		default:
 2877		  assert ("COMPLEX4/COMPLEX bad source kind type" == NULL);
 2878		  break;
 2879		}
 2880	      break;
 2881
 2882	    case FFEINFO_basictypeCHARACTER:
 2883	      error = ffetarget_convert_complex4_character1
 2884		(ffebld_cu_ptr_complex4 (u),
 2885		 ffebld_constant_character1 (ffebld_conter (l)));
 2886	      break;
 2887
 2888	    case FFEINFO_basictypeHOLLERITH:
 2889	      error = ffetarget_convert_complex4_hollerith
 2890		(ffebld_cu_ptr_complex4 (u),
 2891		 ffebld_constant_hollerith (ffebld_conter (l)));
 2892	      break;
 2893
 2894	    case FFEINFO_basictypeTYPELESS:
 2895	      error = ffetarget_convert_complex4_typeless
 2896		(ffebld_cu_ptr_complex4 (u),
 2897		 ffebld_constant_typeless (ffebld_conter (l)));
 2898	      break;
 2899
 2900	    default:
 2901	      assert ("COMPLEX4 bad type" == NULL);
 2902	      break;
 2903	    }
 2904
 2905	  /* If conversion operation is not implemented, return original expr.  */
 2906	  if (error == FFEBAD_NOCANDO)
 2907	    return expr;
 2908
 2909	  expr = ffebld_new_conter_with_orig
 2910	    (ffebld_constant_new_complex4_val
 2911	     (ffebld_cu_val_complex4 (u)), expr);
 2912	  break;
 2913#endif
 2914
 2915	default:
 2916	  assert ("bad complex kind type" == NULL);
 2917	  break;
 2918	}
 2919      break;
 2920
 2921    case FFEINFO_basictypeCHARACTER:
 2922      if ((sz = ffebld_size (expr)) == FFETARGET_charactersizeNONE)
 2923	return expr;
 2924      kt = ffeinfo_kindtype (ffebld_info (expr));
 2925      switch (kt)
 2926	{
 2927#if FFETARGET_okCHARACTER1
 2928	case FFEINFO_kindtypeCHARACTER1:
 2929	  switch (ffeinfo_basictype (ffebld_info (l)))
 2930	    {
 2931	    case FFEINFO_basictypeCHARACTER:
 2932	      if ((sz2 = ffebld_size (l)) == FFETARGET_charactersizeNONE)
 2933		return expr;
 2934	      assert (kt == ffeinfo_kindtype (ffebld_info (l)));
 2935	      assert (sz2 == ffetarget_length_character1
 2936		      (ffebld_constant_character1
 2937		       (ffebld_conter (l))));
 2938	      error
 2939		= ffetarget_convert_character1_character1
 2940		(ffebld_cu_ptr_character1 (u), sz,
 2941		 ffebld_constant_character1 (ffebld_conter (l)),
 2942		 ffebld_constant_pool ());
 2943	      break;
 2944
 2945	    case FFEINFO_basictypeINTEGER:
 2946	      switch (ffeinfo_kindtype (ffebld_info (l)))
 2947		{
 2948#if FFETARGET_okINTEGER1
 2949		case FFEINFO_kindtypeINTEGER1:
 2950		  error
 2951		    = ffetarget_convert_character1_integer1
 2952		      (ffebld_cu_ptr_character1 (u),
 2953		       sz,
 2954		       ffebld_constant_integer1 (ffebld_conter (l)),
 2955		       ffebld_constant_pool ());
 2956		  break;
 2957#endif
 2958
 2959#if FFETARGET_okINTEGER2
 2960		case FFEINFO_kindtypeINTEGER2:
 2961		  error
 2962		    = ffetarget_convert_character1_integer2
 2963		      (ffebld_cu_ptr_character1 (u),
 2964		       sz,
 2965		       ffebld_constant_integer2 (ffebld_conter (l)),
 2966		       ffebld_constant_pool ());
 2967		  break;
 2968#endif
 2969
 2970#if FFETARGET_okINTEGER3
 2971		case FFEINFO_kindtypeINTEGER3:
 2972		  error
 2973		    = ffetarget_convert_character1_integer3
 2974		      (ffebld_cu_ptr_character1 (u),
 2975		       sz,
 2976		       ffebld_constant_integer3 (ffebld_conter (l)),
 2977		       ffebld_constant_pool ());
 2978		  break;
 2979#endif
 2980
 2981#if FFETARGET_okINTEGER4
 2982		case FFEINFO_kindtypeINTEGER4:
 2983		  error
 2984		    = ffetarget_convert_character1_integer4
 2985		      (ffebld_cu_ptr_character1 (u),
 2986		       sz,
 2987		       ffebld_constant_integer4 (ffebld_conter (l)),
 2988		       ffebld_constant_pool ());
 2989		  break;
 2990#endif
 2991
 2992		default:
 2993		  assert ("CHARACTER1/INTEGER bad source kind type" == NULL);
 2994		  break;
 2995		}
 2996	      break;
 2997
 2998	    case FFEINFO_basictypeLOGICAL:
 2999	      switch (ffeinfo_kindtype (ffebld_info (l)))
 3000		{
 3001#if FFETARGET_okLOGICAL1
 3002		case FFEINFO_kindtypeLOGICAL1:
 3003		  error
 3004		    = ffetarget_convert_character1_logical1
 3005		      (ffebld_cu_ptr_character1 (u),
 3006		       sz,
 3007		       ffebld_constant_logical1 (ffebld_conter (l)),
 3008		       ffebld_constant_pool ());
 3009		  break;
 3010#endif
 3011
 3012#if FFETARGET_okLOGICAL2
 3013		case FFEINFO_kindtypeLOGICAL2:
 3014		  error
 3015		    = ffetarget_convert_character1_logical2
 3016		      (ffebld_cu_ptr_character1 (u),
 3017		       sz,
 3018		       ffebld_constant_logical2 (ffebld_conter (l)),
 3019		       ffebld_constant_pool ());
 3020		  break;
 3021#endif
 3022
 3023#if FFETARGET_okLOGICAL3
 3024		case FFEINFO_kindtypeLOGICAL3:
 3025		  error
 3026		    = ffetarget_convert_character1_logical3
 3027		      (ffebld_cu_ptr_character1 (u),
 3028		       sz,
 3029		       ffebld_constant_logical3 (ffebld_conter (l)),
 3030		       ffebld_constant_pool ());
 3031		  break;
 3032#endif
 3033
 3034#if FFETARGET_okLOGICAL4
 3035		case FFEINFO_kindtypeLOGICAL4:
 3036		  error
 3037		    = ffetarget_convert_character1_logical4
 3038		      (ffebld_cu_ptr_character1 (u),
 3039		       sz,
 3040		       ffebld_constant_logical4 (ffebld_conter (l)),
 3041		       ffebld_constant_pool ());
 3042		  break;
 3043#endif
 3044
 3045		default:
 3046		  assert ("CHARACTER1/LOGICAL bad source kind type" == NULL);
 3047		  break;
 3048		}
 3049	      break;
 3050
 3051	    case FFEINFO_basictypeHOLLERITH:
 3052	      error
 3053		= ffetarget_convert_character1_hollerith
 3054		(ffebld_cu_ptr_character1 (u),
 3055		 sz,
 3056		 ffebld_constant_hollerith (ffebld_conter (l)),
 3057		 ffebld_constant_pool ());
 3058	      break;
 3059
 3060	    case FFEINFO_basictypeTYPELESS:
 3061	      error
 3062		= ffetarget_convert_character1_typeless
 3063		(ffebld_cu_ptr_character1 (u),
 3064		 sz,
 3065		 ffebld_constant_typeless (ffebld_conter (l)),
 3066		 ffebld_constant_pool ());
 3067	      break;
 3068
 3069	    default:
 3070	      assert ("CHARACTER1 bad type" == NULL);
 3071	    }
 3072
 3073	  expr
 3074	    = ffebld_new_conter_with_orig
 3075	    (ffebld_constant_new_character1_val
 3076	     (ffebld_cu_val_character1 (u)),
 3077	     expr);
 3078	  break;
 3079#endif
 3080
 3081	default:
 3082	  assert ("bad character kind type" == NULL);
 3083	  break;
 3084	}
 3085      break;
 3086
 3087    default:
 3088      assert ("bad type" == NULL);
 3089      return expr;
 3090    }
 3091
 3092  ffebld_set_info (expr, ffeinfo_new
 3093		   (bt,
 3094		    kt,
 3095		    0,
 3096		    FFEINFO_kindENTITY,
 3097		    FFEINFO_whereCONSTANT,
 3098		    sz));
 3099
 3100  if ((error != FFEBAD)
 3101      && ffebad_start (error))
 3102    {
 3103      assert (t != NULL);
 3104      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 3105      ffebad_finish ();
 3106    }
 3107
 3108  return expr;
 3109}
 3110
 3111/* ffeexpr_collapse_paren -- Collapse paren expr
 3112
 3113   ffebld expr;
 3114   ffelexToken token;
 3115   expr = ffeexpr_collapse_paren(expr,token);
 3116
 3117   If the result of the expr is a constant, replaces the expr with the
 3118   computed constant.  */
 3119
 3120ffebld
 3121ffeexpr_collapse_paren (ffebld expr, ffelexToken t UNUSED)
 3122{
 3123  ffebld r;
 3124  ffeinfoBasictype bt;
 3125  ffeinfoKindtype kt;
 3126  ffetargetCharacterSize len;
 3127
 3128  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 3129    return expr;
 3130
 3131  r = ffebld_left (expr);
 3132
 3133  if (ffebld_op (r) != FFEBLD_opCONTER)
 3134    return expr;
 3135
 3136  bt = ffeinfo_basictype (ffebld_info (r));
 3137  kt = ffeinfo_kindtype (ffebld_info (r));
 3138  len = ffebld_size (r);
 3139
 3140  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
 3141				      expr);
 3142
 3143  ffebld_set_info (expr, ffeinfo_new
 3144		   (bt,
 3145		    kt,
 3146		    0,
 3147		    FFEINFO_kindENTITY,
 3148		    FFEINFO_whereCONSTANT,
 3149		    len));
 3150
 3151  return expr;
 3152}
 3153
 3154/* ffeexpr_collapse_uplus -- Collapse uplus expr
 3155
 3156   ffebld expr;
 3157   ffelexToken token;
 3158   expr = ffeexpr_collapse_uplus(expr,token);
 3159
 3160   If the result of the expr is a constant, replaces the expr with the
 3161   computed constant.  */
 3162
 3163ffebld
 3164ffeexpr_collapse_uplus (ffebld expr, ffelexToken t UNUSED)
 3165{
 3166  ffebld r;
 3167  ffeinfoBasictype bt;
 3168  ffeinfoKindtype kt;
 3169  ffetargetCharacterSize len;
 3170
 3171  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 3172    return expr;
 3173
 3174  r = ffebld_left (expr);
 3175
 3176  if (ffebld_op (r) != FFEBLD_opCONTER)
 3177    return expr;
 3178
 3179  bt = ffeinfo_basictype (ffebld_info (r));
 3180  kt = ffeinfo_kindtype (ffebld_info (r));
 3181  len = ffebld_size (r);
 3182
 3183  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
 3184				      expr);
 3185
 3186  ffebld_set_info (expr, ffeinfo_new
 3187		   (bt,
 3188		    kt,
 3189		    0,
 3190		    FFEINFO_kindENTITY,
 3191		    FFEINFO_whereCONSTANT,
 3192		    len));
 3193
 3194  return expr;
 3195}
 3196
 3197/* ffeexpr_collapse_uminus -- Collapse uminus expr
 3198
 3199   ffebld expr;
 3200   ffelexToken token;
 3201   expr = ffeexpr_collapse_uminus(expr,token);
 3202
 3203   If the result of the expr is a constant, replaces the expr with the
 3204   computed constant.  */
 3205
 3206ffebld
 3207ffeexpr_collapse_uminus (ffebld expr, ffelexToken t)
 3208{
 3209  ffebad error = FFEBAD;
 3210  ffebld r;
 3211  ffebldConstantUnion u;
 3212  ffeinfoBasictype bt;
 3213  ffeinfoKindtype kt;
 3214
 3215  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 3216    return expr;
 3217
 3218  r = ffebld_left (expr);
 3219
 3220  if (ffebld_op (r) != FFEBLD_opCONTER)
 3221    return expr;
 3222
 3223  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 3224    {
 3225    case FFEINFO_basictypeANY:
 3226      return expr;
 3227
 3228    case FFEINFO_basictypeINTEGER:
 3229      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3230	{
 3231#if FFETARGET_okINTEGER1
 3232	case FFEINFO_kindtypeINTEGER1:
 3233	  error = ffetarget_uminus_integer1 (ffebld_cu_ptr_integer1 (u),
 3234			      ffebld_constant_integer1 (ffebld_conter (r)));
 3235	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 3236					(ffebld_cu_val_integer1 (u)), expr);
 3237	  break;
 3238#endif
 3239
 3240#if FFETARGET_okINTEGER2
 3241	case FFEINFO_kindtypeINTEGER2:
 3242	  error = ffetarget_uminus_integer2 (ffebld_cu_ptr_integer2 (u),
 3243			      ffebld_constant_integer2 (ffebld_conter (r)));
 3244	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 3245					(ffebld_cu_val_integer2 (u)), expr);
 3246	  break;
 3247#endif
 3248
 3249#if FFETARGET_okINTEGER3
 3250	case FFEINFO_kindtypeINTEGER3:
 3251	  error = ffetarget_uminus_integer3 (ffebld_cu_ptr_integer3 (u),
 3252			      ffebld_constant_integer3 (ffebld_conter (r)));
 3253	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 3254					(ffebld_cu_val_integer3 (u)), expr);
 3255	  break;
 3256#endif
 3257
 3258#if FFETARGET_okINTEGER4
 3259	case FFEINFO_kindtypeINTEGER4:
 3260	  error = ffetarget_uminus_integer4 (ffebld_cu_ptr_integer4 (u),
 3261			      ffebld_constant_integer4 (ffebld_conter (r)));
 3262	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 3263					(ffebld_cu_val_integer4 (u)), expr);
 3264	  break;
 3265#endif
 3266
 3267	default:
 3268	  assert ("bad integer kind type" == NULL);
 3269	  break;
 3270	}
 3271      break;
 3272
 3273    case FFEINFO_basictypeREAL:
 3274      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3275	{
 3276#if FFETARGET_okREAL1
 3277	case FFEINFO_kindtypeREAL1:
 3278	  error = ffetarget_uminus_real1 (ffebld_cu_ptr_real1 (u),
 3279				 ffebld_constant_real1 (ffebld_conter (r)));
 3280	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
 3281					   (ffebld_cu_val_real1 (u)), expr);
 3282	  break;
 3283#endif
 3284
 3285#if FFETARGET_okREAL2
 3286	case FFEINFO_kindtypeREAL2:
 3287	  error = ffetarget_uminus_real2 (ffebld_cu_ptr_real2 (u),
 3288				 ffebld_constant_real2 (ffebld_conter (r)));
 3289	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
 3290					   (ffebld_cu_val_real2 (u)), expr);
 3291	  break;
 3292#endif
 3293
 3294#if FFETARGET_okREAL3
 3295	case FFEINFO_kindtypeREAL3:
 3296	  error = ffetarget_uminus_real3 (ffebld_cu_ptr_real3 (u),
 3297				 ffebld_constant_real3 (ffebld_conter (r)));
 3298	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
 3299					   (ffebld_cu_val_real3 (u)), expr);
 3300	  break;
 3301#endif
 3302
 3303#if FFETARGET_okREAL4
 3304	case FFEINFO_kindtypeREAL4:
 3305	  error = ffetarget_uminus_real4 (ffebld_cu_ptr_real4 (u),
 3306				 ffebld_constant_real4 (ffebld_conter (r)));
 3307	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
 3308					   (ffebld_cu_val_real4 (u)), expr);
 3309	  break;
 3310#endif
 3311
 3312	default:
 3313	  assert ("bad real kind type" == NULL);
 3314	  break;
 3315	}
 3316      break;
 3317
 3318    case FFEINFO_basictypeCOMPLEX:
 3319      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3320	{
 3321#if FFETARGET_okCOMPLEX1
 3322	case FFEINFO_kindtypeREAL1:
 3323	  error = ffetarget_uminus_complex1 (ffebld_cu_ptr_complex1 (u),
 3324			      ffebld_constant_complex1 (ffebld_conter (r)));
 3325	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
 3326					(ffebld_cu_val_complex1 (u)), expr);
 3327	  break;
 3328#endif
 3329
 3330#if FFETARGET_okCOMPLEX2
 3331	case FFEINFO_kindtypeREAL2:
 3332	  error = ffetarget_uminus_complex2 (ffebld_cu_ptr_complex2 (u),
 3333			      ffebld_constant_complex2 (ffebld_conter (r)));
 3334	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
 3335					(ffebld_cu_val_complex2 (u)), expr);
 3336	  break;
 3337#endif
 3338
 3339#if FFETARGET_okCOMPLEX3
 3340	case FFEINFO_kindtypeREAL3:
 3341	  error = ffetarget_uminus_complex3 (ffebld_cu_ptr_complex3 (u),
 3342			      ffebld_constant_complex3 (ffebld_conter (r)));
 3343	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
 3344					(ffebld_cu_val_complex3 (u)), expr);
 3345	  break;
 3346#endif
 3347
 3348#if FFETARGET_okCOMPLEX4
 3349	case FFEINFO_kindtypeREAL4:
 3350	  error = ffetarget_uminus_complex4 (ffebld_cu_ptr_complex4 (u),
 3351			      ffebld_constant_complex4 (ffebld_conter (r)));
 3352	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
 3353					(ffebld_cu_val_complex4 (u)), expr);
 3354	  break;
 3355#endif
 3356
 3357	default:
 3358	  assert ("bad complex kind type" == NULL);
 3359	  break;
 3360	}
 3361      break;
 3362
 3363    default:
 3364      assert ("bad type" == NULL);
 3365      return expr;
 3366    }
 3367
 3368  ffebld_set_info (expr, ffeinfo_new
 3369		   (bt,
 3370		    kt,
 3371		    0,
 3372		    FFEINFO_kindENTITY,
 3373		    FFEINFO_whereCONSTANT,
 3374		    FFETARGET_charactersizeNONE));
 3375
 3376  if ((error != FFEBAD)
 3377      && ffebad_start (error))
 3378    {
 3379      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 3380      ffebad_finish ();
 3381    }
 3382
 3383  return expr;
 3384}
 3385
 3386/* ffeexpr_collapse_not -- Collapse not expr
 3387
 3388   ffebld expr;
 3389   ffelexToken token;
 3390   expr = ffeexpr_collapse_not(expr,token);
 3391
 3392   If the result of the expr is a constant, replaces the expr with the
 3393   computed constant.  */
 3394
 3395ffebld
 3396ffeexpr_collapse_not (ffebld expr, ffelexToken t)
 3397{
 3398  ffebad error = FFEBAD;
 3399  ffebld r;
 3400  ffebldConstantUnion u;
 3401  ffeinfoBasictype bt;
 3402  ffeinfoKindtype kt;
 3403
 3404  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 3405    return expr;
 3406
 3407  r = ffebld_left (expr);
 3408
 3409  if (ffebld_op (r) != FFEBLD_opCONTER)
 3410    return expr;
 3411
 3412  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 3413    {
 3414    case FFEINFO_basictypeANY:
 3415      return expr;
 3416
 3417    case FFEINFO_basictypeINTEGER:
 3418      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3419	{
 3420#if FFETARGET_okINTEGER1
 3421	case FFEINFO_kindtypeINTEGER1:
 3422	  error = ffetarget_not_integer1 (ffebld_cu_ptr_integer1 (u),
 3423			      ffebld_constant_integer1 (ffebld_conter (r)));
 3424	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 3425					(ffebld_cu_val_integer1 (u)), expr);
 3426	  break;
 3427#endif
 3428
 3429#if FFETARGET_okINTEGER2
 3430	case FFEINFO_kindtypeINTEGER2:
 3431	  error = ffetarget_not_integer2 (ffebld_cu_ptr_integer2 (u),
 3432			      ffebld_constant_integer2 (ffebld_conter (r)));
 3433	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 3434					(ffebld_cu_val_integer2 (u)), expr);
 3435	  break;
 3436#endif
 3437
 3438#if FFETARGET_okINTEGER3
 3439	case FFEINFO_kindtypeINTEGER3:
 3440	  error = ffetarget_not_integer3 (ffebld_cu_ptr_integer3 (u),
 3441			      ffebld_constant_integer3 (ffebld_conter (r)));
 3442	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 3443					(ffebld_cu_val_integer3 (u)), expr);
 3444	  break;
 3445#endif
 3446
 3447#if FFETARGET_okINTEGER4
 3448	case FFEINFO_kindtypeINTEGER4:
 3449	  error = ffetarget_not_integer4 (ffebld_cu_ptr_integer4 (u),
 3450			      ffebld_constant_integer4 (ffebld_conter (r)));
 3451	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 3452					(ffebld_cu_val_integer4 (u)), expr);
 3453	  break;
 3454#endif
 3455
 3456	default:
 3457	  assert ("bad integer kind type" == NULL);
 3458	  break;
 3459	}
 3460      break;
 3461
 3462    case FFEINFO_basictypeLOGICAL:
 3463      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3464	{
 3465#if FFETARGET_okLOGICAL1
 3466	case FFEINFO_kindtypeLOGICAL1:
 3467	  error = ffetarget_not_logical1 (ffebld_cu_ptr_logical1 (u),
 3468			      ffebld_constant_logical1 (ffebld_conter (r)));
 3469	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
 3470					(ffebld_cu_val_logical1 (u)), expr);
 3471	  break;
 3472#endif
 3473
 3474#if FFETARGET_okLOGICAL2
 3475	case FFEINFO_kindtypeLOGICAL2:
 3476	  error = ffetarget_not_logical2 (ffebld_cu_ptr_logical2 (u),
 3477			      ffebld_constant_logical2 (ffebld_conter (r)));
 3478	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
 3479					(ffebld_cu_val_logical2 (u)), expr);
 3480	  break;
 3481#endif
 3482
 3483#if FFETARGET_okLOGICAL3
 3484	case FFEINFO_kindtypeLOGICAL3:
 3485	  error = ffetarget_not_logical3 (ffebld_cu_ptr_logical3 (u),
 3486			      ffebld_constant_logical3 (ffebld_conter (r)));
 3487	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
 3488					(ffebld_cu_val_logical3 (u)), expr);
 3489	  break;
 3490#endif
 3491
 3492#if FFETARGET_okLOGICAL4
 3493	case FFEINFO_kindtypeLOGICAL4:
 3494	  error = ffetarget_not_logical4 (ffebld_cu_ptr_logical4 (u),
 3495			      ffebld_constant_logical4 (ffebld_conter (r)));
 3496	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
 3497					(ffebld_cu_val_logical4 (u)), expr);
 3498	  break;
 3499#endif
 3500
 3501	default:
 3502	  assert ("bad logical kind type" == NULL);
 3503	  break;
 3504	}
 3505      break;
 3506
 3507    default:
 3508      assert ("bad type" == NULL);
 3509      return expr;
 3510    }
 3511
 3512  ffebld_set_info (expr, ffeinfo_new
 3513		   (bt,
 3514		    kt,
 3515		    0,
 3516		    FFEINFO_kindENTITY,
 3517		    FFEINFO_whereCONSTANT,
 3518		    FFETARGET_charactersizeNONE));
 3519
 3520  if ((error != FFEBAD)
 3521      && ffebad_start (error))
 3522    {
 3523      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 3524      ffebad_finish ();
 3525    }
 3526
 3527  return expr;
 3528}
 3529
 3530/* ffeexpr_collapse_add -- Collapse add expr
 3531
 3532   ffebld expr;
 3533   ffelexToken token;
 3534   expr = ffeexpr_collapse_add(expr,token);
 3535
 3536   If the result of the expr is a constant, replaces the expr with the
 3537   computed constant.  */
 3538
 3539ffebld
 3540ffeexpr_collapse_add (ffebld expr, ffelexToken t)
 3541{
 3542  ffebad error = FFEBAD;
 3543  ffebld l;
 3544  ffebld r;
 3545  ffebldConstantUnion u;
 3546  ffeinfoBasictype bt;
 3547  ffeinfoKindtype kt;
 3548
 3549  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 3550    return expr;
 3551
 3552  l = ffebld_left (expr);
 3553  r = ffebld_right (expr);
 3554
 3555  if (ffebld_op (l) != FFEBLD_opCONTER)
 3556    return expr;
 3557  if (ffebld_op (r) != FFEBLD_opCONTER)
 3558    return expr;
 3559
 3560  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 3561    {
 3562    case FFEINFO_basictypeANY:
 3563      return expr;
 3564
 3565    case FFEINFO_basictypeINTEGER:
 3566      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3567	{
 3568#if FFETARGET_okINTEGER1
 3569	case FFEINFO_kindtypeINTEGER1:
 3570	  error = ffetarget_add_integer1 (ffebld_cu_ptr_integer1 (u),
 3571			       ffebld_constant_integer1 (ffebld_conter (l)),
 3572			      ffebld_constant_integer1 (ffebld_conter (r)));
 3573	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 3574					(ffebld_cu_val_integer1 (u)), expr);
 3575	  break;
 3576#endif
 3577
 3578#if FFETARGET_okINTEGER2
 3579	case FFEINFO_kindtypeINTEGER2:
 3580	  error = ffetarget_add_integer2 (ffebld_cu_ptr_integer2 (u),
 3581			       ffebld_constant_integer2 (ffebld_conter (l)),
 3582			      ffebld_constant_integer2 (ffebld_conter (r)));
 3583	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 3584					(ffebld_cu_val_integer2 (u)), expr);
 3585	  break;
 3586#endif
 3587
 3588#if FFETARGET_okINTEGER3
 3589	case FFEINFO_kindtypeINTEGER3:
 3590	  error = ffetarget_add_integer3 (ffebld_cu_ptr_integer3 (u),
 3591			       ffebld_constant_integer3 (ffebld_conter (l)),
 3592			      ffebld_constant_integer3 (ffebld_conter (r)));
 3593	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 3594					(ffebld_cu_val_integer3 (u)), expr);
 3595	  break;
 3596#endif
 3597
 3598#if FFETARGET_okINTEGER4
 3599	case FFEINFO_kindtypeINTEGER4:
 3600	  error = ffetarget_add_integer4 (ffebld_cu_ptr_integer4 (u),
 3601			       ffebld_constant_integer4 (ffebld_conter (l)),
 3602			      ffebld_constant_integer4 (ffebld_conter (r)));
 3603	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 3604					(ffebld_cu_val_integer4 (u)), expr);
 3605	  break;
 3606#endif
 3607
 3608	default:
 3609	  assert ("bad integer kind type" == NULL);
 3610	  break;
 3611	}
 3612      break;
 3613
 3614    case FFEINFO_basictypeREAL:
 3615      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3616	{
 3617#if FFETARGET_okREAL1
 3618	case FFEINFO_kindtypeREAL1:
 3619	  error = ffetarget_add_real1 (ffebld_cu_ptr_real1 (u),
 3620				  ffebld_constant_real1 (ffebld_conter (l)),
 3621				 ffebld_constant_real1 (ffebld_conter (r)));
 3622	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
 3623					   (ffebld_cu_val_real1 (u)), expr);
 3624	  break;
 3625#endif
 3626
 3627#if FFETARGET_okREAL2
 3628	case FFEINFO_kindtypeREAL2:
 3629	  error = ffetarget_add_real2 (ffebld_cu_ptr_real2 (u),
 3630				  ffebld_constant_real2 (ffebld_conter (l)),
 3631				 ffebld_constant_real2 (ffebld_conter (r)));
 3632	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
 3633					   (ffebld_cu_val_real2 (u)), expr);
 3634	  break;
 3635#endif
 3636
 3637#if FFETARGET_okREAL3
 3638	case FFEINFO_kindtypeREAL3:
 3639	  error = ffetarget_add_real3 (ffebld_cu_ptr_real3 (u),
 3640				  ffebld_constant_real3 (ffebld_conter (l)),
 3641				 ffebld_constant_real3 (ffebld_conter (r)));
 3642	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
 3643					   (ffebld_cu_val_real3 (u)), expr);
 3644	  break;
 3645#endif
 3646
 3647#if FFETARGET_okREAL4
 3648	case FFEINFO_kindtypeREAL4:
 3649	  error = ffetarget_add_real4 (ffebld_cu_ptr_real4 (u),
 3650				  ffebld_constant_real4 (ffebld_conter (l)),
 3651				 ffebld_constant_real4 (ffebld_conter (r)));
 3652	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
 3653					   (ffebld_cu_val_real4 (u)), expr);
 3654	  break;
 3655#endif
 3656
 3657	default:
 3658	  assert ("bad real kind type" == NULL);
 3659	  break;
 3660	}
 3661      break;
 3662
 3663    case FFEINFO_basictypeCOMPLEX:
 3664      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3665	{
 3666#if FFETARGET_okCOMPLEX1
 3667	case FFEINFO_kindtypeREAL1:
 3668	  error = ffetarget_add_complex1 (ffebld_cu_ptr_complex1 (u),
 3669			       ffebld_constant_complex1 (ffebld_conter (l)),
 3670			      ffebld_constant_complex1 (ffebld_conter (r)));
 3671	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
 3672					(ffebld_cu_val_complex1 (u)), expr);
 3673	  break;
 3674#endif
 3675
 3676#if FFETARGET_okCOMPLEX2
 3677	case FFEINFO_kindtypeREAL2:
 3678	  error = ffetarget_add_complex2 (ffebld_cu_ptr_complex2 (u),
 3679			       ffebld_constant_complex2 (ffebld_conter (l)),
 3680			      ffebld_constant_complex2 (ffebld_conter (r)));
 3681	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
 3682					(ffebld_cu_val_complex2 (u)), expr);
 3683	  break;
 3684#endif
 3685
 3686#if FFETARGET_okCOMPLEX3
 3687	case FFEINFO_kindtypeREAL3:
 3688	  error = ffetarget_add_complex3 (ffebld_cu_ptr_complex3 (u),
 3689			       ffebld_constant_complex3 (ffebld_conter (l)),
 3690			      ffebld_constant_complex3 (ffebld_conter (r)));
 3691	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
 3692					(ffebld_cu_val_complex3 (u)), expr);
 3693	  break;
 3694#endif
 3695
 3696#if FFETARGET_okCOMPLEX4
 3697	case FFEINFO_kindtypeREAL4:
 3698	  error = ffetarget_add_complex4 (ffebld_cu_ptr_complex4 (u),
 3699			       ffebld_constant_complex4 (ffebld_conter (l)),
 3700			      ffebld_constant_complex4 (ffebld_conter (r)));
 3701	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
 3702					(ffebld_cu_val_complex4 (u)), expr);
 3703	  break;
 3704#endif
 3705
 3706	default:
 3707	  assert ("bad complex kind type" == NULL);
 3708	  break;
 3709	}
 3710      break;
 3711
 3712    default:
 3713      assert ("bad type" == NULL);
 3714      return expr;
 3715    }
 3716
 3717  ffebld_set_info (expr, ffeinfo_new
 3718		   (bt,
 3719		    kt,
 3720		    0,
 3721		    FFEINFO_kindENTITY,
 3722		    FFEINFO_whereCONSTANT,
 3723		    FFETARGET_charactersizeNONE));
 3724
 3725  if ((error != FFEBAD)
 3726      && ffebad_start (error))
 3727    {
 3728      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 3729      ffebad_finish ();
 3730    }
 3731
 3732  return expr;
 3733}
 3734
 3735/* ffeexpr_collapse_subtract -- Collapse subtract expr
 3736
 3737   ffebld expr;
 3738   ffelexToken token;
 3739   expr = ffeexpr_collapse_subtract(expr,token);
 3740
 3741   If the result of the expr is a constant, replaces the expr with the
 3742   computed constant.  */
 3743
 3744ffebld
 3745ffeexpr_collapse_subtract (ffebld expr, ffelexToken t)
 3746{
 3747  ffebad error = FFEBAD;
 3748  ffebld l;
 3749  ffebld r;
 3750  ffebldConstantUnion u;
 3751  ffeinfoBasictype bt;
 3752  ffeinfoKindtype kt;
 3753
 3754  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 3755    return expr;
 3756
 3757  l = ffebld_left (expr);
 3758  r = ffebld_right (expr);
 3759
 3760  if (ffebld_op (l) != FFEBLD_opCONTER)
 3761    return expr;
 3762  if (ffebld_op (r) != FFEBLD_opCONTER)
 3763    return expr;
 3764
 3765  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 3766    {
 3767    case FFEINFO_basictypeANY:
 3768      return expr;
 3769
 3770    case FFEINFO_basictypeINTEGER:
 3771      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3772	{
 3773#if FFETARGET_okINTEGER1
 3774	case FFEINFO_kindtypeINTEGER1:
 3775	  error = ffetarget_subtract_integer1 (ffebld_cu_ptr_integer1 (u),
 3776			       ffebld_constant_integer1 (ffebld_conter (l)),
 3777			      ffebld_constant_integer1 (ffebld_conter (r)));
 3778	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 3779					(ffebld_cu_val_integer1 (u)), expr);
 3780	  break;
 3781#endif
 3782
 3783#if FFETARGET_okINTEGER2
 3784	case FFEINFO_kindtypeINTEGER2:
 3785	  error = ffetarget_subtract_integer2 (ffebld_cu_ptr_integer2 (u),
 3786			       ffebld_constant_integer2 (ffebld_conter (l)),
 3787			      ffebld_constant_integer2 (ffebld_conter (r)));
 3788	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 3789					(ffebld_cu_val_integer2 (u)), expr);
 3790	  break;
 3791#endif
 3792
 3793#if FFETARGET_okINTEGER3
 3794	case FFEINFO_kindtypeINTEGER3:
 3795	  error = ffetarget_subtract_integer3 (ffebld_cu_ptr_integer3 (u),
 3796			       ffebld_constant_integer3 (ffebld_conter (l)),
 3797			      ffebld_constant_integer3 (ffebld_conter (r)));
 3798	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 3799					(ffebld_cu_val_integer3 (u)), expr);
 3800	  break;
 3801#endif
 3802
 3803#if FFETARGET_okINTEGER4
 3804	case FFEINFO_kindtypeINTEGER4:
 3805	  error = ffetarget_subtract_integer4 (ffebld_cu_ptr_integer4 (u),
 3806			       ffebld_constant_integer4 (ffebld_conter (l)),
 3807			      ffebld_constant_integer4 (ffebld_conter (r)));
 3808	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 3809					(ffebld_cu_val_integer4 (u)), expr);
 3810	  break;
 3811#endif
 3812
 3813	default:
 3814	  assert ("bad integer kind type" == NULL);
 3815	  break;
 3816	}
 3817      break;
 3818
 3819    case FFEINFO_basictypeREAL:
 3820      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3821	{
 3822#if FFETARGET_okREAL1
 3823	case FFEINFO_kindtypeREAL1:
 3824	  error = ffetarget_subtract_real1 (ffebld_cu_ptr_real1 (u),
 3825				  ffebld_constant_real1 (ffebld_conter (l)),
 3826				 ffebld_constant_real1 (ffebld_conter (r)));
 3827	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
 3828					   (ffebld_cu_val_real1 (u)), expr);
 3829	  break;
 3830#endif
 3831
 3832#if FFETARGET_okREAL2
 3833	case FFEINFO_kindtypeREAL2:
 3834	  error = ffetarget_subtract_real2 (ffebld_cu_ptr_real2 (u),
 3835				  ffebld_constant_real2 (ffebld_conter (l)),
 3836				 ffebld_constant_real2 (ffebld_conter (r)));
 3837	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
 3838					   (ffebld_cu_val_real2 (u)), expr);
 3839	  break;
 3840#endif
 3841
 3842#if FFETARGET_okREAL3
 3843	case FFEINFO_kindtypeREAL3:
 3844	  error = ffetarget_subtract_real3 (ffebld_cu_ptr_real3 (u),
 3845				  ffebld_constant_real3 (ffebld_conter (l)),
 3846				 ffebld_constant_real3 (ffebld_conter (r)));
 3847	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
 3848					   (ffebld_cu_val_real3 (u)), expr);
 3849	  break;
 3850#endif
 3851
 3852#if FFETARGET_okREAL4
 3853	case FFEINFO_kindtypeREAL4:
 3854	  error = ffetarget_subtract_real4 (ffebld_cu_ptr_real4 (u),
 3855				  ffebld_constant_real4 (ffebld_conter (l)),
 3856				 ffebld_constant_real4 (ffebld_conter (r)));
 3857	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
 3858					   (ffebld_cu_val_real4 (u)), expr);
 3859	  break;
 3860#endif
 3861
 3862	default:
 3863	  assert ("bad real kind type" == NULL);
 3864	  break;
 3865	}
 3866      break;
 3867
 3868    case FFEINFO_basictypeCOMPLEX:
 3869      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3870	{
 3871#if FFETARGET_okCOMPLEX1
 3872	case FFEINFO_kindtypeREAL1:
 3873	  error = ffetarget_subtract_complex1 (ffebld_cu_ptr_complex1 (u),
 3874			       ffebld_constant_complex1 (ffebld_conter (l)),
 3875			      ffebld_constant_complex1 (ffebld_conter (r)));
 3876	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
 3877					(ffebld_cu_val_complex1 (u)), expr);
 3878	  break;
 3879#endif
 3880
 3881#if FFETARGET_okCOMPLEX2
 3882	case FFEINFO_kindtypeREAL2:
 3883	  error = ffetarget_subtract_complex2 (ffebld_cu_ptr_complex2 (u),
 3884			       ffebld_constant_complex2 (ffebld_conter (l)),
 3885			      ffebld_constant_complex2 (ffebld_conter (r)));
 3886	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
 3887					(ffebld_cu_val_complex2 (u)), expr);
 3888	  break;
 3889#endif
 3890
 3891#if FFETARGET_okCOMPLEX3
 3892	case FFEINFO_kindtypeREAL3:
 3893	  error = ffetarget_subtract_complex3 (ffebld_cu_ptr_complex3 (u),
 3894			       ffebld_constant_complex3 (ffebld_conter (l)),
 3895			      ffebld_constant_complex3 (ffebld_conter (r)));
 3896	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
 3897					(ffebld_cu_val_complex3 (u)), expr);
 3898	  break;
 3899#endif
 3900
 3901#if FFETARGET_okCOMPLEX4
 3902	case FFEINFO_kindtypeREAL4:
 3903	  error = ffetarget_subtract_complex4 (ffebld_cu_ptr_complex4 (u),
 3904			       ffebld_constant_complex4 (ffebld_conter (l)),
 3905			      ffebld_constant_complex4 (ffebld_conter (r)));
 3906	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
 3907					(ffebld_cu_val_complex4 (u)), expr);
 3908	  break;
 3909#endif
 3910
 3911	default:
 3912	  assert ("bad complex kind type" == NULL);
 3913	  break;
 3914	}
 3915      break;
 3916
 3917    default:
 3918      assert ("bad type" == NULL);
 3919      return expr;
 3920    }
 3921
 3922  ffebld_set_info (expr, ffeinfo_new
 3923		   (bt,
 3924		    kt,
 3925		    0,
 3926		    FFEINFO_kindENTITY,
 3927		    FFEINFO_whereCONSTANT,
 3928		    FFETARGET_charactersizeNONE));
 3929
 3930  if ((error != FFEBAD)
 3931      && ffebad_start (error))
 3932    {
 3933      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 3934      ffebad_finish ();
 3935    }
 3936
 3937  return expr;
 3938}
 3939
 3940/* ffeexpr_collapse_multiply -- Collapse multiply expr
 3941
 3942   ffebld expr;
 3943   ffelexToken token;
 3944   expr = ffeexpr_collapse_multiply(expr,token);
 3945
 3946   If the result of the expr is a constant, replaces the expr with the
 3947   computed constant.  */
 3948
 3949ffebld
 3950ffeexpr_collapse_multiply (ffebld expr, ffelexToken t)
 3951{
 3952  ffebad error = FFEBAD;
 3953  ffebld l;
 3954  ffebld r;
 3955  ffebldConstantUnion u;
 3956  ffeinfoBasictype bt;
 3957  ffeinfoKindtype kt;
 3958
 3959  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 3960    return expr;
 3961
 3962  l = ffebld_left (expr);
 3963  r = ffebld_right (expr);
 3964
 3965  if (ffebld_op (l) != FFEBLD_opCONTER)
 3966    return expr;
 3967  if (ffebld_op (r) != FFEBLD_opCONTER)
 3968    return expr;
 3969
 3970  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 3971    {
 3972    case FFEINFO_basictypeANY:
 3973      return expr;
 3974
 3975    case FFEINFO_basictypeINTEGER:
 3976      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 3977	{
 3978#if FFETARGET_okINTEGER1
 3979	case FFEINFO_kindtypeINTEGER1:
 3980	  error = ffetarget_multiply_integer1 (ffebld_cu_ptr_integer1 (u),
 3981			       ffebld_constant_integer1 (ffebld_conter (l)),
 3982			      ffebld_constant_integer1 (ffebld_conter (r)));
 3983	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 3984					(ffebld_cu_val_integer1 (u)), expr);
 3985	  break;
 3986#endif
 3987
 3988#if FFETARGET_okINTEGER2
 3989	case FFEINFO_kindtypeINTEGER2:
 3990	  error = ffetarget_multiply_integer2 (ffebld_cu_ptr_integer2 (u),
 3991			       ffebld_constant_integer2 (ffebld_conter (l)),
 3992			      ffebld_constant_integer2 (ffebld_conter (r)));
 3993	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 3994					(ffebld_cu_val_integer2 (u)), expr);
 3995	  break;
 3996#endif
 3997
 3998#if FFETARGET_okINTEGER3
 3999	case FFEINFO_kindtypeINTEGER3:
 4000	  error = ffetarget_multiply_integer3 (ffebld_cu_ptr_integer3 (u),
 4001			       ffebld_constant_integer3 (ffebld_conter (l)),
 4002			      ffebld_constant_integer3 (ffebld_conter (r)));
 4003	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 4004					(ffebld_cu_val_integer3 (u)), expr);
 4005	  break;
 4006#endif
 4007
 4008#if FFETARGET_okINTEGER4
 4009	case FFEINFO_kindtypeINTEGER4:
 4010	  error = ffetarget_multiply_integer4 (ffebld_cu_ptr_integer4 (u),
 4011			       ffebld_constant_integer4 (ffebld_conter (l)),
 4012			      ffebld_constant_integer4 (ffebld_conter (r)));
 4013	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 4014					(ffebld_cu_val_integer4 (u)), expr);
 4015	  break;
 4016#endif
 4017
 4018	default:
 4019	  assert ("bad integer kind type" == NULL);
 4020	  break;
 4021	}
 4022      break;
 4023
 4024    case FFEINFO_basictypeREAL:
 4025      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4026	{
 4027#if FFETARGET_okREAL1
 4028	case FFEINFO_kindtypeREAL1:
 4029	  error = ffetarget_multiply_real1 (ffebld_cu_ptr_real1 (u),
 4030				  ffebld_constant_real1 (ffebld_conter (l)),
 4031				 ffebld_constant_real1 (ffebld_conter (r)));
 4032	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
 4033					   (ffebld_cu_val_real1 (u)), expr);
 4034	  break;
 4035#endif
 4036
 4037#if FFETARGET_okREAL2
 4038	case FFEINFO_kindtypeREAL2:
 4039	  error = ffetarget_multiply_real2 (ffebld_cu_ptr_real2 (u),
 4040				  ffebld_constant_real2 (ffebld_conter (l)),
 4041				 ffebld_constant_real2 (ffebld_conter (r)));
 4042	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
 4043					   (ffebld_cu_val_real2 (u)), expr);
 4044	  break;
 4045#endif
 4046
 4047#if FFETARGET_okREAL3
 4048	case FFEINFO_kindtypeREAL3:
 4049	  error = ffetarget_multiply_real3 (ffebld_cu_ptr_real3 (u),
 4050				  ffebld_constant_real3 (ffebld_conter (l)),
 4051				 ffebld_constant_real3 (ffebld_conter (r)));
 4052	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
 4053					   (ffebld_cu_val_real3 (u)), expr);
 4054	  break;
 4055#endif
 4056
 4057#if FFETARGET_okREAL4
 4058	case FFEINFO_kindtypeREAL4:
 4059	  error = ffetarget_multiply_real4 (ffebld_cu_ptr_real4 (u),
 4060				  ffebld_constant_real4 (ffebld_conter (l)),
 4061				 ffebld_constant_real4 (ffebld_conter (r)));
 4062	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
 4063					   (ffebld_cu_val_real4 (u)), expr);
 4064	  break;
 4065#endif
 4066
 4067	default:
 4068	  assert ("bad real kind type" == NULL);
 4069	  break;
 4070	}
 4071      break;
 4072
 4073    case FFEINFO_basictypeCOMPLEX:
 4074      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4075	{
 4076#if FFETARGET_okCOMPLEX1
 4077	case FFEINFO_kindtypeREAL1:
 4078	  error = ffetarget_multiply_complex1 (ffebld_cu_ptr_complex1 (u),
 4079			       ffebld_constant_complex1 (ffebld_conter (l)),
 4080			      ffebld_constant_complex1 (ffebld_conter (r)));
 4081	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
 4082					(ffebld_cu_val_complex1 (u)), expr);
 4083	  break;
 4084#endif
 4085
 4086#if FFETARGET_okCOMPLEX2
 4087	case FFEINFO_kindtypeREAL2:
 4088	  error = ffetarget_multiply_complex2 (ffebld_cu_ptr_complex2 (u),
 4089			       ffebld_constant_complex2 (ffebld_conter (l)),
 4090			      ffebld_constant_complex2 (ffebld_conter (r)));
 4091	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
 4092					(ffebld_cu_val_complex2 (u)), expr);
 4093	  break;
 4094#endif
 4095
 4096#if FFETARGET_okCOMPLEX3
 4097	case FFEINFO_kindtypeREAL3:
 4098	  error = ffetarget_multiply_complex3 (ffebld_cu_ptr_complex3 (u),
 4099			       ffebld_constant_complex3 (ffebld_conter (l)),
 4100			      ffebld_constant_complex3 (ffebld_conter (r)));
 4101	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
 4102					(ffebld_cu_val_complex3 (u)), expr);
 4103	  break;
 4104#endif
 4105
 4106#if FFETARGET_okCOMPLEX4
 4107	case FFEINFO_kindtypeREAL4:
 4108	  error = ffetarget_multiply_complex4 (ffebld_cu_ptr_complex4 (u),
 4109			       ffebld_constant_complex4 (ffebld_conter (l)),
 4110			      ffebld_constant_complex4 (ffebld_conter (r)));
 4111	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
 4112					(ffebld_cu_val_complex4 (u)), expr);
 4113	  break;
 4114#endif
 4115
 4116	default:
 4117	  assert ("bad complex kind type" == NULL);
 4118	  break;
 4119	}
 4120      break;
 4121
 4122    default:
 4123      assert ("bad type" == NULL);
 4124      return expr;
 4125    }
 4126
 4127  ffebld_set_info (expr, ffeinfo_new
 4128		   (bt,
 4129		    kt,
 4130		    0,
 4131		    FFEINFO_kindENTITY,
 4132		    FFEINFO_whereCONSTANT,
 4133		    FFETARGET_charactersizeNONE));
 4134
 4135  if ((error != FFEBAD)
 4136      && ffebad_start (error))
 4137    {
 4138      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 4139      ffebad_finish ();
 4140    }
 4141
 4142  return expr;
 4143}
 4144
 4145/* ffeexpr_collapse_divide -- Collapse divide expr
 4146
 4147   ffebld expr;
 4148   ffelexToken token;
 4149   expr = ffeexpr_collapse_divide(expr,token);
 4150
 4151   If the result of the expr is a constant, replaces the expr with the
 4152   computed constant.  */
 4153
 4154ffebld
 4155ffeexpr_collapse_divide (ffebld expr, ffelexToken t)
 4156{
 4157  ffebad error = FFEBAD;
 4158  ffebld l;
 4159  ffebld r;
 4160  ffebldConstantUnion u;
 4161  ffeinfoBasictype bt;
 4162  ffeinfoKindtype kt;
 4163
 4164  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 4165    return expr;
 4166
 4167  l = ffebld_left (expr);
 4168  r = ffebld_right (expr);
 4169
 4170  if (ffebld_op (l) != FFEBLD_opCONTER)
 4171    return expr;
 4172  if (ffebld_op (r) != FFEBLD_opCONTER)
 4173    return expr;
 4174
 4175  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 4176    {
 4177    case FFEINFO_basictypeANY:
 4178      return expr;
 4179
 4180    case FFEINFO_basictypeINTEGER:
 4181      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4182	{
 4183#if FFETARGET_okINTEGER1
 4184	case FFEINFO_kindtypeINTEGER1:
 4185	  error = ffetarget_divide_integer1 (ffebld_cu_ptr_integer1 (u),
 4186			       ffebld_constant_integer1 (ffebld_conter (l)),
 4187			      ffebld_constant_integer1 (ffebld_conter (r)));
 4188	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 4189					(ffebld_cu_val_integer1 (u)), expr);
 4190	  break;
 4191#endif
 4192
 4193#if FFETARGET_okINTEGER2
 4194	case FFEINFO_kindtypeINTEGER2:
 4195	  error = ffetarget_divide_integer2 (ffebld_cu_ptr_integer2 (u),
 4196			       ffebld_constant_integer2 (ffebld_conter (l)),
 4197			      ffebld_constant_integer2 (ffebld_conter (r)));
 4198	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 4199					(ffebld_cu_val_integer2 (u)), expr);
 4200	  break;
 4201#endif
 4202
 4203#if FFETARGET_okINTEGER3
 4204	case FFEINFO_kindtypeINTEGER3:
 4205	  error = ffetarget_divide_integer3 (ffebld_cu_ptr_integer3 (u),
 4206			       ffebld_constant_integer3 (ffebld_conter (l)),
 4207			      ffebld_constant_integer3 (ffebld_conter (r)));
 4208	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 4209					(ffebld_cu_val_integer3 (u)), expr);
 4210	  break;
 4211#endif
 4212
 4213#if FFETARGET_okINTEGER4
 4214	case FFEINFO_kindtypeINTEGER4:
 4215	  error = ffetarget_divide_integer4 (ffebld_cu_ptr_integer4 (u),
 4216			       ffebld_constant_integer4 (ffebld_conter (l)),
 4217			      ffebld_constant_integer4 (ffebld_conter (r)));
 4218	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 4219					(ffebld_cu_val_integer4 (u)), expr);
 4220	  break;
 4221#endif
 4222
 4223	default:
 4224	  assert ("bad integer kind type" == NULL);
 4225	  break;
 4226	}
 4227      break;
 4228
 4229    case FFEINFO_basictypeREAL:
 4230      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4231	{
 4232#if FFETARGET_okREAL1
 4233	case FFEINFO_kindtypeREAL1:
 4234	  error = ffetarget_divide_real1 (ffebld_cu_ptr_real1 (u),
 4235				  ffebld_constant_real1 (ffebld_conter (l)),
 4236				 ffebld_constant_real1 (ffebld_conter (r)));
 4237	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
 4238					   (ffebld_cu_val_real1 (u)), expr);
 4239	  break;
 4240#endif
 4241
 4242#if FFETARGET_okREAL2
 4243	case FFEINFO_kindtypeREAL2:
 4244	  error = ffetarget_divide_real2 (ffebld_cu_ptr_real2 (u),
 4245				  ffebld_constant_real2 (ffebld_conter (l)),
 4246				 ffebld_constant_real2 (ffebld_conter (r)));
 4247	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
 4248					   (ffebld_cu_val_real2 (u)), expr);
 4249	  break;
 4250#endif
 4251
 4252#if FFETARGET_okREAL3
 4253	case FFEINFO_kindtypeREAL3:
 4254	  error = ffetarget_divide_real3 (ffebld_cu_ptr_real3 (u),
 4255				  ffebld_constant_real3 (ffebld_conter (l)),
 4256				 ffebld_constant_real3 (ffebld_conter (r)));
 4257	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
 4258					   (ffebld_cu_val_real3 (u)), expr);
 4259	  break;
 4260#endif
 4261
 4262#if FFETARGET_okREAL4
 4263	case FFEINFO_kindtypeREAL4:
 4264	  error = ffetarget_divide_real4 (ffebld_cu_ptr_real4 (u),
 4265				  ffebld_constant_real4 (ffebld_conter (l)),
 4266				 ffebld_constant_real4 (ffebld_conter (r)));
 4267	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
 4268					   (ffebld_cu_val_real4 (u)), expr);
 4269	  break;
 4270#endif
 4271
 4272	default:
 4273	  assert ("bad real kind type" == NULL);
 4274	  break;
 4275	}
 4276      break;
 4277
 4278    case FFEINFO_basictypeCOMPLEX:
 4279      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4280	{
 4281#if FFETARGET_okCOMPLEX1
 4282	case FFEINFO_kindtypeREAL1:
 4283	  error = ffetarget_divide_complex1 (ffebld_cu_ptr_complex1 (u),
 4284			       ffebld_constant_complex1 (ffebld_conter (l)),
 4285			      ffebld_constant_complex1 (ffebld_conter (r)));
 4286	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
 4287					(ffebld_cu_val_complex1 (u)), expr);
 4288	  break;
 4289#endif
 4290
 4291#if FFETARGET_okCOMPLEX2
 4292	case FFEINFO_kindtypeREAL2:
 4293	  error = ffetarget_divide_complex2 (ffebld_cu_ptr_complex2 (u),
 4294			       ffebld_constant_complex2 (ffebld_conter (l)),
 4295			      ffebld_constant_complex2 (ffebld_conter (r)));
 4296	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
 4297					(ffebld_cu_val_complex2 (u)), expr);
 4298	  break;
 4299#endif
 4300
 4301#if FFETARGET_okCOMPLEX3
 4302	case FFEINFO_kindtypeREAL3:
 4303	  error = ffetarget_divide_complex3 (ffebld_cu_ptr_complex3 (u),
 4304			       ffebld_constant_complex3 (ffebld_conter (l)),
 4305			      ffebld_constant_complex3 (ffebld_conter (r)));
 4306	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
 4307					(ffebld_cu_val_complex3 (u)), expr);
 4308	  break;
 4309#endif
 4310
 4311#if FFETARGET_okCOMPLEX4
 4312	case FFEINFO_kindtypeREAL4:
 4313	  error = ffetarget_divide_complex4 (ffebld_cu_ptr_complex4 (u),
 4314			       ffebld_constant_complex4 (ffebld_conter (l)),
 4315			      ffebld_constant_complex4 (ffebld_conter (r)));
 4316	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
 4317					(ffebld_cu_val_complex4 (u)), expr);
 4318	  break;
 4319#endif
 4320
 4321	default:
 4322	  assert ("bad complex kind type" == NULL);
 4323	  break;
 4324	}
 4325      break;
 4326
 4327    default:
 4328      assert ("bad type" == NULL);
 4329      return expr;
 4330    }
 4331
 4332  ffebld_set_info (expr, ffeinfo_new
 4333		   (bt,
 4334		    kt,
 4335		    0,
 4336		    FFEINFO_kindENTITY,
 4337		    FFEINFO_whereCONSTANT,
 4338		    FFETARGET_charactersizeNONE));
 4339
 4340  if ((error != FFEBAD)
 4341      && ffebad_start (error))
 4342    {
 4343      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 4344      ffebad_finish ();
 4345    }
 4346
 4347  return expr;
 4348}
 4349
 4350/* ffeexpr_collapse_power -- Collapse power expr
 4351
 4352   ffebld expr;
 4353   ffelexToken token;
 4354   expr = ffeexpr_collapse_power(expr,token);
 4355
 4356   If the result of the expr is a constant, replaces the expr with the
 4357   computed constant.  */
 4358
 4359ffebld
 4360ffeexpr_collapse_power (ffebld expr, ffelexToken t)
 4361{
 4362  ffebad error = FFEBAD;
 4363  ffebld l;
 4364  ffebld r;
 4365  ffebldConstantUnion u;
 4366  ffeinfoBasictype bt;
 4367  ffeinfoKindtype kt;
 4368
 4369  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 4370    return expr;
 4371
 4372  l = ffebld_left (expr);
 4373  r = ffebld_right (expr);
 4374
 4375  if (ffebld_op (l) != FFEBLD_opCONTER)
 4376    return expr;
 4377  if (ffebld_op (r) != FFEBLD_opCONTER)
 4378    return expr;
 4379
 4380  if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER)
 4381  || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT))
 4382    return expr;
 4383
 4384  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 4385    {
 4386    case FFEINFO_basictypeANY:
 4387      return expr;
 4388
 4389    case FFEINFO_basictypeINTEGER:
 4390      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4391	{
 4392	case FFEINFO_kindtypeINTEGERDEFAULT:
 4393	  error = ffetarget_power_integerdefault_integerdefault
 4394	    (ffebld_cu_ptr_integerdefault (u),
 4395	     ffebld_constant_integerdefault (ffebld_conter (l)),
 4396	     ffebld_constant_integerdefault (ffebld_conter (r)));
 4397	  expr = ffebld_new_conter_with_orig
 4398	    (ffebld_constant_new_integerdefault_val
 4399	     (ffebld_cu_val_integerdefault (u)), expr);
 4400	  break;
 4401
 4402	default:
 4403	  assert ("bad integer kind type" == NULL);
 4404	  break;
 4405	}
 4406      break;
 4407
 4408    case FFEINFO_basictypeREAL:
 4409      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4410	{
 4411	case FFEINFO_kindtypeREALDEFAULT:
 4412	  error = ffetarget_power_realdefault_integerdefault
 4413	    (ffebld_cu_ptr_realdefault (u),
 4414	     ffebld_constant_realdefault (ffebld_conter (l)),
 4415	     ffebld_constant_integerdefault (ffebld_conter (r)));
 4416	  expr = ffebld_new_conter_with_orig
 4417	    (ffebld_constant_new_realdefault_val
 4418	     (ffebld_cu_val_realdefault (u)), expr);
 4419	  break;
 4420
 4421	case FFEINFO_kindtypeREALDOUBLE:
 4422	  error = ffetarget_power_realdouble_integerdefault
 4423	    (ffebld_cu_ptr_realdouble (u),
 4424	     ffebld_constant_realdouble (ffebld_conter (l)),
 4425	     ffebld_constant_integerdefault (ffebld_conter (r)));
 4426	  expr = ffebld_new_conter_with_orig
 4427	    (ffebld_constant_new_realdouble_val
 4428	     (ffebld_cu_val_realdouble (u)), expr);
 4429	  break;
 4430
 4431#if FFETARGET_okREALQUAD
 4432	case FFEINFO_kindtypeREALQUAD:
 4433	  error = ffetarget_power_realquad_integerdefault
 4434	    (ffebld_cu_ptr_realquad (u),
 4435	     ffebld_constant_realquad (ffebld_conter (l)),
 4436	     ffebld_constant_integerdefault (ffebld_conter (r)));
 4437	  expr = ffebld_new_conter_with_orig
 4438	    (ffebld_constant_new_realquad_val
 4439	     (ffebld_cu_val_realquad (u)), expr);
 4440	  break;
 4441#endif
 4442	default:
 4443	  assert ("bad real kind type" == NULL);
 4444	  break;
 4445	}
 4446      break;
 4447
 4448    case FFEINFO_basictypeCOMPLEX:
 4449      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4450	{
 4451	case FFEINFO_kindtypeREALDEFAULT:
 4452	  error = ffetarget_power_complexdefault_integerdefault
 4453	    (ffebld_cu_ptr_complexdefault (u),
 4454	     ffebld_constant_complexdefault (ffebld_conter (l)),
 4455	     ffebld_constant_integerdefault (ffebld_conter (r)));
 4456	  expr = ffebld_new_conter_with_orig
 4457	    (ffebld_constant_new_complexdefault_val
 4458	     (ffebld_cu_val_complexdefault (u)), expr);
 4459	  break;
 4460
 4461#if FFETARGET_okCOMPLEXDOUBLE
 4462	case FFEINFO_kindtypeREALDOUBLE:
 4463	  error = ffetarget_power_complexdouble_integerdefault
 4464	    (ffebld_cu_ptr_complexdouble (u),
 4465	     ffebld_constant_complexdouble (ffebld_conter (l)),
 4466	     ffebld_constant_integerdefault (ffebld_conter (r)));
 4467	  expr = ffebld_new_conter_with_orig
 4468	    (ffebld_constant_new_complexdouble_val
 4469	     (ffebld_cu_val_complexdouble (u)), expr);
 4470	  break;
 4471#endif
 4472
 4473#if FFETARGET_okCOMPLEXQUAD
 4474	case FFEINFO_kindtypeREALQUAD:
 4475	  error = ffetarget_power_complexquad_integerdefault
 4476	    (ffebld_cu_ptr_complexquad (u),
 4477	     ffebld_constant_complexquad (ffebld_conter (l)),
 4478	     ffebld_constant_integerdefault (ffebld_conter (r)));
 4479	  expr = ffebld_new_conter_with_orig
 4480	    (ffebld_constant_new_complexquad_val
 4481	     (ffebld_cu_val_complexquad (u)), expr);
 4482	  break;
 4483#endif
 4484
 4485	default:
 4486	  assert ("bad complex kind type" == NULL);
 4487	  break;
 4488	}
 4489      break;
 4490
 4491    default:
 4492      assert ("bad type" == NULL);
 4493      return expr;
 4494    }
 4495
 4496  ffebld_set_info (expr, ffeinfo_new
 4497		   (bt,
 4498		    kt,
 4499		    0,
 4500		    FFEINFO_kindENTITY,
 4501		    FFEINFO_whereCONSTANT,
 4502		    FFETARGET_charactersizeNONE));
 4503
 4504  if ((error != FFEBAD)
 4505      && ffebad_start (error))
 4506    {
 4507      ffebad_here (0, ffelex_token_where_line (t),
 4508		   ffelex_token_where_column (t));
 4509      ffebad_finish ();
 4510    }
 4511
 4512  return expr;
 4513}
 4514
 4515/* ffeexpr_collapse_concatenate -- Collapse concatenate expr
 4516
 4517   ffebld expr;
 4518   ffelexToken token;
 4519   expr = ffeexpr_collapse_concatenate(expr,token);
 4520
 4521   If the result of the expr is a constant, replaces the expr with the
 4522   computed constant.  */
 4523
 4524ffebld
 4525ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t)
 4526{
 4527  ffebad error = FFEBAD;
 4528  ffebld l;
 4529  ffebld r;
 4530  ffebldConstantUnion u;
 4531  ffeinfoKindtype kt;
 4532  ffetargetCharacterSize len;
 4533
 4534  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 4535    return expr;
 4536
 4537  l = ffebld_left (expr);
 4538  r = ffebld_right (expr);
 4539
 4540  if (ffebld_op (l) != FFEBLD_opCONTER)
 4541    return expr;
 4542  if (ffebld_op (r) != FFEBLD_opCONTER)
 4543    return expr;
 4544
 4545  switch (ffeinfo_basictype (ffebld_info (expr)))
 4546    {
 4547    case FFEINFO_basictypeANY:
 4548      return expr;
 4549
 4550    case FFEINFO_basictypeCHARACTER:
 4551      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 4552	{
 4553#if FFETARGET_okCHARACTER1
 4554	case FFEINFO_kindtypeCHARACTER1:
 4555	  error = ffetarget_concatenate_character1 (ffebld_cu_ptr_character1 (u),
 4556			     ffebld_constant_character1 (ffebld_conter (l)),
 4557			     ffebld_constant_character1 (ffebld_conter (r)),
 4558				   ffebld_constant_pool (), &len);
 4559	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val
 4560				      (ffebld_cu_val_character1 (u)), expr);
 4561	  break;
 4562#endif
 4563
 4564#if FFETARGET_okCHARACTER2
 4565	case FFEINFO_kindtypeCHARACTER2:
 4566	  error = ffetarget_concatenate_character2 (ffebld_cu_ptr_character2 (u),
 4567			     ffebld_constant_character2 (ffebld_conter (l)),
 4568			     ffebld_constant_character2 (ffebld_conter (r)),
 4569				   ffebld_constant_pool (), &len);
 4570	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val
 4571				      (ffebld_cu_val_character2 (u)), expr);
 4572	  break;
 4573#endif
 4574
 4575#if FFETARGET_okCHARACTER3
 4576	case FFEINFO_kindtypeCHARACTER3:
 4577	  error = ffetarget_concatenate_character3 (ffebld_cu_ptr_character3 (u),
 4578			     ffebld_constant_character3 (ffebld_conter (l)),
 4579			     ffebld_constant_character3 (ffebld_conter (r)),
 4580				   ffebld_constant_pool (), &len);
 4581	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val
 4582				      (ffebld_cu_val_character3 (u)), expr);
 4583	  break;
 4584#endif
 4585
 4586#if FFETARGET_okCHARACTER4
 4587	case FFEINFO_kindtypeCHARACTER4:
 4588	  error = ffetarget_concatenate_character4 (ffebld_cu_ptr_character4 (u),
 4589			     ffebld_constant_character4 (ffebld_conter (l)),
 4590			     ffebld_constant_character4 (ffebld_conter (r)),
 4591				   ffebld_constant_pool (), &len);
 4592	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val
 4593				      (ffebld_cu_val_character4 (u)), expr);
 4594	  break;
 4595#endif
 4596
 4597	default:
 4598	  assert ("bad character kind type" == NULL);
 4599	  break;
 4600	}
 4601      break;
 4602
 4603    default:
 4604      assert ("bad type" == NULL);
 4605      return expr;
 4606    }
 4607
 4608  ffebld_set_info (expr, ffeinfo_new
 4609		   (FFEINFO_basictypeCHARACTER,
 4610		    kt,
 4611		    0,
 4612		    FFEINFO_kindENTITY,
 4613		    FFEINFO_whereCONSTANT,
 4614		    len));
 4615
 4616  if ((error != FFEBAD)
 4617      && ffebad_start (error))
 4618    {
 4619      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 4620      ffebad_finish ();
 4621    }
 4622
 4623  return expr;
 4624}
 4625
 4626/* ffeexpr_collapse_eq -- Collapse eq expr
 4627
 4628   ffebld expr;
 4629   ffelexToken token;
 4630   expr = ffeexpr_collapse_eq(expr,token);
 4631
 4632   If the result of the expr is a constant, replaces the expr with the
 4633   computed constant.  */
 4634
 4635ffebld
 4636ffeexpr_collapse_eq (ffebld expr, ffelexToken t)
 4637{
 4638  ffebad error = FFEBAD;
 4639  ffebld l;
 4640  ffebld r;
 4641  bool val;
 4642
 4643  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 4644    return expr;
 4645
 4646  l = ffebld_left (expr);
 4647  r = ffebld_right (expr);
 4648
 4649  if (ffebld_op (l) != FFEBLD_opCONTER)
 4650    return expr;
 4651  if (ffebld_op (r) != FFEBLD_opCONTER)
 4652    return expr;
 4653
 4654  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
 4655    {
 4656    case FFEINFO_basictypeANY:
 4657      return expr;
 4658
 4659    case FFEINFO_basictypeINTEGER:
 4660      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 4661	{
 4662#if FFETARGET_okINTEGER1
 4663	case FFEINFO_kindtypeINTEGER1:
 4664	  error = ffetarget_eq_integer1 (&val,
 4665			       ffebld_constant_integer1 (ffebld_conter (l)),
 4666			      ffebld_constant_integer1 (ffebld_conter (r)));
 4667	  expr = ffebld_new_conter_with_orig
 4668	    (ffebld_constant_new_logicaldefault (val), expr);
 4669	  break;
 4670#endif
 4671
 4672#if FFETARGET_okINTEGER2
 4673	case FFEINFO_kindtypeINTEGER2:
 4674	  error = ffetarget_eq_integer2 (&val,
 4675			       ffebld_constant_integer2 (ffebld_conter (l)),
 4676			      ffebld_constant_integer2 (ffebld_conter (r)));
 4677	  expr = ffebld_new_conter_with_orig
 4678	    (ffebld_constant_new_logicaldefault (val), expr);
 4679	  break;
 4680#endif
 4681
 4682#if FFETARGET_okINTEGER3
 4683	case FFEINFO_kindtypeINTEGER3:
 4684	  error = ffetarget_eq_integer3 (&val,
 4685			       ffebld_constant_integer3 (ffebld_conter (l)),
 4686			      ffebld_constant_integer3 (ffebld_conter (r)));
 4687	  expr = ffebld_new_conter_with_orig
 4688	    (ffebld_constant_new_logicaldefault (val), expr);
 4689	  break;
 4690#endif
 4691
 4692#if FFETARGET_okINTEGER4
 4693	case FFEINFO_kindtypeINTEGER4:
 4694	  error = ffetarget_eq_integer4 (&val,
 4695			       ffebld_constant_integer4 (ffebld_conter (l)),
 4696			      ffebld_constant_integer4 (ffebld_conter (r)));
 4697	  expr = ffebld_new_conter_with_orig
 4698	    (ffebld_constant_new_logicaldefault (val), expr);
 4699	  break;
 4700#endif
 4701
 4702	default:
 4703	  assert ("bad integer kind type" == NULL);
 4704	  break;
 4705	}
 4706      break;
 4707
 4708    case FFEINFO_basictypeREAL:
 4709      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 4710	{
 4711#if FFETARGET_okREAL1
 4712	case FFEINFO_kindtypeREAL1:
 4713	  error = ffetarget_eq_real1 (&val,
 4714				  ffebld_constant_real1 (ffebld_conter (l)),
 4715				 ffebld_constant_real1 (ffebld_conter (r)));
 4716	  expr = ffebld_new_conter_with_orig
 4717	    (ffebld_constant_new_logicaldefault (val), expr);
 4718	  break;
 4719#endif
 4720
 4721#if FFETARGET_okREAL2
 4722	case FFEINFO_kindtypeREAL2:
 4723	  error = ffetarget_eq_real2 (&val,
 4724				  ffebld_constant_real2 (ffebld_conter (l)),
 4725				 ffebld_constant_real2 (ffebld_conter (r)));
 4726	  expr = ffebld_new_conter_with_orig
 4727	    (ffebld_constant_new_logicaldefault (val), expr);
 4728	  break;
 4729#endif
 4730
 4731#if FFETARGET_okREAL3
 4732	case FFEINFO_kindtypeREAL3:
 4733	  error = ffetarget_eq_real3 (&val,
 4734				  ffebld_constant_real3 (ffebld_conter (l)),
 4735				 ffebld_constant_real3 (ffebld_conter (r)));
 4736	  expr = ffebld_new_conter_with_orig
 4737	    (ffebld_constant_new_logicaldefault (val), expr);
 4738	  break;
 4739#endif
 4740
 4741#if FFETARGET_okREAL4
 4742	case FFEINFO_kindtypeREAL4:
 4743	  error = ffetarget_eq_real4 (&val,
 4744				  ffebld_constant_real4 (ffebld_conter (l)),
 4745				 ffebld_constant_real4 (ffebld_conter (r)));
 4746	  expr = ffebld_new_conter_with_orig
 4747	    (ffebld_constant_new_logicaldefault (val), expr);
 4748	  break;
 4749#endif
 4750
 4751	default:
 4752	  assert ("bad real kind type" == NULL);
 4753	  break;
 4754	}
 4755      break;
 4756
 4757    case FFEINFO_basictypeCOMPLEX:
 4758      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 4759	{
 4760#if FFETARGET_okCOMPLEX1
 4761	case FFEINFO_kindtypeREAL1:
 4762	  error = ffetarget_eq_complex1 (&val,
 4763			       ffebld_constant_complex1 (ffebld_conter (l)),
 4764			      ffebld_constant_complex1 (ffebld_conter (r)));
 4765	  expr = ffebld_new_conter_with_orig
 4766	    (ffebld_constant_new_logicaldefault (val), expr);
 4767	  break;
 4768#endif
 4769
 4770#if FFETARGET_okCOMPLEX2
 4771	case FFEINFO_kindtypeREAL2:
 4772	  error = ffetarget_eq_complex2 (&val,
 4773			       ffebld_constant_complex2 (ffebld_conter (l)),
 4774			      ffebld_constant_complex2 (ffebld_conter (r)));
 4775	  expr = ffebld_new_conter_with_orig
 4776	    (ffebld_constant_new_logicaldefault (val), expr);
 4777	  break;
 4778#endif
 4779
 4780#if FFETARGET_okCOMPLEX3
 4781	case FFEINFO_kindtypeREAL3:
 4782	  error = ffetarget_eq_complex3 (&val,
 4783			       ffebld_constant_complex3 (ffebld_conter (l)),
 4784			      ffebld_constant_complex3 (ffebld_conter (r)));
 4785	  expr = ffebld_new_conter_with_orig
 4786	    (ffebld_constant_new_logicaldefault (val), expr);
 4787	  break;
 4788#endif
 4789
 4790#if FFETARGET_okCOMPLEX4
 4791	case FFEINFO_kindtypeREAL4:
 4792	  error = ffetarget_eq_complex4 (&val,
 4793			       ffebld_constant_complex4 (ffebld_conter (l)),
 4794			      ffebld_constant_complex4 (ffebld_conter (r)));
 4795	  expr = ffebld_new_conter_with_orig
 4796	    (ffebld_constant_new_logicaldefault (val), expr);
 4797	  break;
 4798#endif
 4799
 4800	default:
 4801	  assert ("bad complex kind type" == NULL);
 4802	  break;
 4803	}
 4804      break;
 4805
 4806    case FFEINFO_basictypeCHARACTER:
 4807      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 4808	{
 4809#if FFETARGET_okCHARACTER1
 4810	case FFEINFO_kindtypeCHARACTER1:
 4811	  error = ffetarget_eq_character1 (&val,
 4812			     ffebld_constant_character1 (ffebld_conter (l)),
 4813			    ffebld_constant_character1 (ffebld_conter (r)));
 4814	  expr = ffebld_new_conter_with_orig
 4815	    (ffebld_constant_new_logicaldefault (val), expr);
 4816	  break;
 4817#endif
 4818
 4819#if FFETARGET_okCHARACTER2
 4820	case FFEINFO_kindtypeCHARACTER2:
 4821	  error = ffetarget_eq_character2 (&val,
 4822			     ffebld_constant_character2 (ffebld_conter (l)),
 4823			    ffebld_constant_character2 (ffebld_conter (r)));
 4824	  expr = ffebld_new_conter_with_orig
 4825	    (ffebld_constant_new_logicaldefault (val), expr);
 4826	  break;
 4827#endif
 4828
 4829#if FFETARGET_okCHARACTER3
 4830	case FFEINFO_kindtypeCHARACTER3:
 4831	  error = ffetarget_eq_character3 (&val,
 4832			     ffebld_constant_character3 (ffebld_conter (l)),
 4833			    ffebld_constant_character3 (ffebld_conter (r)));
 4834	  expr = ffebld_new_conter_with_orig
 4835	    (ffebld_constant_new_logicaldefault (val), expr);
 4836	  break;
 4837#endif
 4838
 4839#if FFETARGET_okCHARACTER4
 4840	case FFEINFO_kindtypeCHARACTER4:
 4841	  error = ffetarget_eq_character4 (&val,
 4842			     ffebld_constant_character4 (ffebld_conter (l)),
 4843			    ffebld_constant_character4 (ffebld_conter (r)));
 4844	  expr = ffebld_new_conter_with_orig
 4845	    (ffebld_constant_new_logicaldefault (val), expr);
 4846	  break;
 4847#endif
 4848
 4849	default:
 4850	  assert ("bad character kind type" == NULL);
 4851	  break;
 4852	}
 4853      break;
 4854
 4855    default:
 4856      assert ("bad type" == NULL);
 4857      return expr;
 4858    }
 4859
 4860  ffebld_set_info (expr, ffeinfo_new
 4861		   (FFEINFO_basictypeLOGICAL,
 4862		    FFEINFO_kindtypeLOGICALDEFAULT,
 4863		    0,
 4864		    FFEINFO_kindENTITY,
 4865		    FFEINFO_whereCONSTANT,
 4866		    FFETARGET_charactersizeNONE));
 4867
 4868  if ((error != FFEBAD)
 4869      && ffebad_start (error))
 4870    {
 4871      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 4872      ffebad_finish ();
 4873    }
 4874
 4875  return expr;
 4876}
 4877
 4878/* ffeexpr_collapse_ne -- Collapse ne expr
 4879
 4880   ffebld expr;
 4881   ffelexToken token;
 4882   expr = ffeexpr_collapse_ne(expr,token);
 4883
 4884   If the result of the expr is a constant, replaces the expr with the
 4885   computed constant.  */
 4886
 4887ffebld
 4888ffeexpr_collapse_ne (ffebld expr, ffelexToken t)
 4889{
 4890  ffebad error = FFEBAD;
 4891  ffebld l;
 4892  ffebld r;
 4893  bool val;
 4894
 4895  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 4896    return expr;
 4897
 4898  l = ffebld_left (expr);
 4899  r = ffebld_right (expr);
 4900
 4901  if (ffebld_op (l) != FFEBLD_opCONTER)
 4902    return expr;
 4903  if (ffebld_op (r) != FFEBLD_opCONTER)
 4904    return expr;
 4905
 4906  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
 4907    {
 4908    case FFEINFO_basictypeANY:
 4909      return expr;
 4910
 4911    case FFEINFO_basictypeINTEGER:
 4912      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 4913	{
 4914#if FFETARGET_okINTEGER1
 4915	case FFEINFO_kindtypeINTEGER1:
 4916	  error = ffetarget_ne_integer1 (&val,
 4917			       ffebld_constant_integer1 (ffebld_conter (l)),
 4918			      ffebld_constant_integer1 (ffebld_conter (r)));
 4919	  expr = ffebld_new_conter_with_orig
 4920	    (ffebld_constant_new_logicaldefault (val), expr);
 4921	  break;
 4922#endif
 4923
 4924#if FFETARGET_okINTEGER2
 4925	case FFEINFO_kindtypeINTEGER2:
 4926	  error = ffetarget_ne_integer2 (&val,
 4927			       ffebld_constant_integer2 (ffebld_conter (l)),
 4928			      ffebld_constant_integer2 (ffebld_conter (r)));
 4929	  expr = ffebld_new_conter_with_orig
 4930	    (ffebld_constant_new_logicaldefault (val), expr);
 4931	  break;
 4932#endif
 4933
 4934#if FFETARGET_okINTEGER3
 4935	case FFEINFO_kindtypeINTEGER3:
 4936	  error = ffetarget_ne_integer3 (&val,
 4937			       ffebld_constant_integer3 (ffebld_conter (l)),
 4938			      ffebld_constant_integer3 (ffebld_conter (r)));
 4939	  expr = ffebld_new_conter_with_orig
 4940	    (ffebld_constant_new_logicaldefault (val), expr);
 4941	  break;
 4942#endif
 4943
 4944#if FFETARGET_okINTEGER4
 4945	case FFEINFO_kindtypeINTEGER4:
 4946	  error = ffetarget_ne_integer4 (&val,
 4947			       ffebld_constant_integer4 (ffebld_conter (l)),
 4948			      ffebld_constant_integer4 (ffebld_conter (r)));
 4949	  expr = ffebld_new_conter_with_orig
 4950	    (ffebld_constant_new_logicaldefault (val), expr);
 4951	  break;
 4952#endif
 4953
 4954	default:
 4955	  assert ("bad integer kind type" == NULL);
 4956	  break;
 4957	}
 4958      break;
 4959
 4960    case FFEINFO_basictypeREAL:
 4961      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 4962	{
 4963#if FFETARGET_okREAL1
 4964	case FFEINFO_kindtypeREAL1:
 4965	  error = ffetarget_ne_real1 (&val,
 4966				  ffebld_constant_real1 (ffebld_conter (l)),
 4967				 ffebld_constant_real1 (ffebld_conter (r)));
 4968	  expr = ffebld_new_conter_with_orig
 4969	    (ffebld_constant_new_logicaldefault (val), expr);
 4970	  break;
 4971#endif
 4972
 4973#if FFETARGET_okREAL2
 4974	case FFEINFO_kindtypeREAL2:
 4975	  error = ffetarget_ne_real2 (&val,
 4976				  ffebld_constant_real2 (ffebld_conter (l)),
 4977				 ffebld_constant_real2 (ffebld_conter (r)));
 4978	  expr = ffebld_new_conter_with_orig
 4979	    (ffebld_constant_new_logicaldefault (val), expr);
 4980	  break;
 4981#endif
 4982
 4983#if FFETARGET_okREAL3
 4984	case FFEINFO_kindtypeREAL3:
 4985	  error = ffetarget_ne_real3 (&val,
 4986				  ffebld_constant_real3 (ffebld_conter (l)),
 4987				 ffebld_constant_real3 (ffebld_conter (r)));
 4988	  expr = ffebld_new_conter_with_orig
 4989	    (ffebld_constant_new_logicaldefault (val), expr);
 4990	  break;
 4991#endif
 4992
 4993#if FFETARGET_okREAL4
 4994	case FFEINFO_kindtypeREAL4:
 4995	  error = ffetarget_ne_real4 (&val,
 4996				  ffebld_constant_real4 (ffebld_conter (l)),
 4997				 ffebld_constant_real4 (ffebld_conter (r)));
 4998	  expr = ffebld_new_conter_with_orig
 4999	    (ffebld_constant_new_logicaldefault (val), expr);
 5000	  break;
 5001#endif
 5002
 5003	default:
 5004	  assert ("bad real kind type" == NULL);
 5005	  break;
 5006	}
 5007      break;
 5008
 5009    case FFEINFO_basictypeCOMPLEX:
 5010      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5011	{
 5012#if FFETARGET_okCOMPLEX1
 5013	case FFEINFO_kindtypeREAL1:
 5014	  error = ffetarget_ne_complex1 (&val,
 5015			       ffebld_constant_complex1 (ffebld_conter (l)),
 5016			      ffebld_constant_complex1 (ffebld_conter (r)));
 5017	  expr = ffebld_new_conter_with_orig
 5018	    (ffebld_constant_new_logicaldefault (val), expr);
 5019	  break;
 5020#endif
 5021
 5022#if FFETARGET_okCOMPLEX2
 5023	case FFEINFO_kindtypeREAL2:
 5024	  error = ffetarget_ne_complex2 (&val,
 5025			       ffebld_constant_complex2 (ffebld_conter (l)),
 5026			      ffebld_constant_complex2 (ffebld_conter (r)));
 5027	  expr = ffebld_new_conter_with_orig
 5028	    (ffebld_constant_new_logicaldefault (val), expr);
 5029	  break;
 5030#endif
 5031
 5032#if FFETARGET_okCOMPLEX3
 5033	case FFEINFO_kindtypeREAL3:
 5034	  error = ffetarget_ne_complex3 (&val,
 5035			       ffebld_constant_complex3 (ffebld_conter (l)),
 5036			      ffebld_constant_complex3 (ffebld_conter (r)));
 5037	  expr = ffebld_new_conter_with_orig
 5038	    (ffebld_constant_new_logicaldefault (val), expr);
 5039	  break;
 5040#endif
 5041
 5042#if FFETARGET_okCOMPLEX4
 5043	case FFEINFO_kindtypeREAL4:
 5044	  error = ffetarget_ne_complex4 (&val,
 5045			       ffebld_constant_complex4 (ffebld_conter (l)),
 5046			      ffebld_constant_complex4 (ffebld_conter (r)));
 5047	  expr = ffebld_new_conter_with_orig
 5048	    (ffebld_constant_new_logicaldefault (val), expr);
 5049	  break;
 5050#endif
 5051
 5052	default:
 5053	  assert ("bad complex kind type" == NULL);
 5054	  break;
 5055	}
 5056      break;
 5057
 5058    case FFEINFO_basictypeCHARACTER:
 5059      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5060	{
 5061#if FFETARGET_okCHARACTER1
 5062	case FFEINFO_kindtypeCHARACTER1:
 5063	  error = ffetarget_ne_character1 (&val,
 5064			     ffebld_constant_character1 (ffebld_conter (l)),
 5065			    ffebld_constant_character1 (ffebld_conter (r)));
 5066	  expr = ffebld_new_conter_with_orig
 5067	    (ffebld_constant_new_logicaldefault (val), expr);
 5068	  break;
 5069#endif
 5070
 5071#if FFETARGET_okCHARACTER2
 5072	case FFEINFO_kindtypeCHARACTER2:
 5073	  error = ffetarget_ne_character2 (&val,
 5074			     ffebld_constant_character2 (ffebld_conter (l)),
 5075			    ffebld_constant_character2 (ffebld_conter (r)));
 5076	  expr = ffebld_new_conter_with_orig
 5077	    (ffebld_constant_new_logicaldefault (val), expr);
 5078	  break;
 5079#endif
 5080
 5081#if FFETARGET_okCHARACTER3
 5082	case FFEINFO_kindtypeCHARACTER3:
 5083	  error = ffetarget_ne_character3 (&val,
 5084			     ffebld_constant_character3 (ffebld_conter (l)),
 5085			    ffebld_constant_character3 (ffebld_conter (r)));
 5086	  expr = ffebld_new_conter_with_orig
 5087	    (ffebld_constant_new_logicaldefault (val), expr);
 5088	  break;
 5089#endif
 5090
 5091#if FFETARGET_okCHARACTER4
 5092	case FFEINFO_kindtypeCHARACTER4:
 5093	  error = ffetarget_ne_character4 (&val,
 5094			     ffebld_constant_character4 (ffebld_conter (l)),
 5095			    ffebld_constant_character4 (ffebld_conter (r)));
 5096	  expr = ffebld_new_conter_with_orig
 5097	    (ffebld_constant_new_logicaldefault (val), expr);
 5098	  break;
 5099#endif
 5100
 5101	default:
 5102	  assert ("bad character kind type" == NULL);
 5103	  break;
 5104	}
 5105      break;
 5106
 5107    default:
 5108      assert ("bad type" == NULL);
 5109      return expr;
 5110    }
 5111
 5112  ffebld_set_info (expr, ffeinfo_new
 5113		   (FFEINFO_basictypeLOGICAL,
 5114		    FFEINFO_kindtypeLOGICALDEFAULT,
 5115		    0,
 5116		    FFEINFO_kindENTITY,
 5117		    FFEINFO_whereCONSTANT,
 5118		    FFETARGET_charactersizeNONE));
 5119
 5120  if ((error != FFEBAD)
 5121      && ffebad_start (error))
 5122    {
 5123      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 5124      ffebad_finish ();
 5125    }
 5126
 5127  return expr;
 5128}
 5129
 5130/* ffeexpr_collapse_ge -- Collapse ge expr
 5131
 5132   ffebld expr;
 5133   ffelexToken token;
 5134   expr = ffeexpr_collapse_ge(expr,token);
 5135
 5136   If the result of the expr is a constant, replaces the expr with the
 5137   computed constant.  */
 5138
 5139ffebld
 5140ffeexpr_collapse_ge (ffebld expr, ffelexToken t)
 5141{
 5142  ffebad error = FFEBAD;
 5143  ffebld l;
 5144  ffebld r;
 5145  bool val;
 5146
 5147  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 5148    return expr;
 5149
 5150  l = ffebld_left (expr);
 5151  r = ffebld_right (expr);
 5152
 5153  if (ffebld_op (l) != FFEBLD_opCONTER)
 5154    return expr;
 5155  if (ffebld_op (r) != FFEBLD_opCONTER)
 5156    return expr;
 5157
 5158  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
 5159    {
 5160    case FFEINFO_basictypeANY:
 5161      return expr;
 5162
 5163    case FFEINFO_basictypeINTEGER:
 5164      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5165	{
 5166#if FFETARGET_okINTEGER1
 5167	case FFEINFO_kindtypeINTEGER1:
 5168	  error = ffetarget_ge_integer1 (&val,
 5169			       ffebld_constant_integer1 (ffebld_conter (l)),
 5170			      ffebld_constant_integer1 (ffebld_conter (r)));
 5171	  expr = ffebld_new_conter_with_orig
 5172	    (ffebld_constant_new_logicaldefault (val), expr);
 5173	  break;
 5174#endif
 5175
 5176#if FFETARGET_okINTEGER2
 5177	case FFEINFO_kindtypeINTEGER2:
 5178	  error = ffetarget_ge_integer2 (&val,
 5179			       ffebld_constant_integer2 (ffebld_conter (l)),
 5180			      ffebld_constant_integer2 (ffebld_conter (r)));
 5181	  expr = ffebld_new_conter_with_orig
 5182	    (ffebld_constant_new_logicaldefault (val), expr);
 5183	  break;
 5184#endif
 5185
 5186#if FFETARGET_okINTEGER3
 5187	case FFEINFO_kindtypeINTEGER3:
 5188	  error = ffetarget_ge_integer3 (&val,
 5189			       ffebld_constant_integer3 (ffebld_conter (l)),
 5190			      ffebld_constant_integer3 (ffebld_conter (r)));
 5191	  expr = ffebld_new_conter_with_orig
 5192	    (ffebld_constant_new_logicaldefault (val), expr);
 5193	  break;
 5194#endif
 5195
 5196#if FFETARGET_okINTEGER4
 5197	case FFEINFO_kindtypeINTEGER4:
 5198	  error = ffetarget_ge_integer4 (&val,
 5199			       ffebld_constant_integer4 (ffebld_conter (l)),
 5200			      ffebld_constant_integer4 (ffebld_conter (r)));
 5201	  expr = ffebld_new_conter_with_orig
 5202	    (ffebld_constant_new_logicaldefault (val), expr);
 5203	  break;
 5204#endif
 5205
 5206	default:
 5207	  assert ("bad integer kind type" == NULL);
 5208	  break;
 5209	}
 5210      break;
 5211
 5212    case FFEINFO_basictypeREAL:
 5213      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5214	{
 5215#if FFETARGET_okREAL1
 5216	case FFEINFO_kindtypeREAL1:
 5217	  error = ffetarget_ge_real1 (&val,
 5218				  ffebld_constant_real1 (ffebld_conter (l)),
 5219				 ffebld_constant_real1 (ffebld_conter (r)));
 5220	  expr = ffebld_new_conter_with_orig
 5221	    (ffebld_constant_new_logicaldefault (val), expr);
 5222	  break;
 5223#endif
 5224
 5225#if FFETARGET_okREAL2
 5226	case FFEINFO_kindtypeREAL2:
 5227	  error = ffetarget_ge_real2 (&val,
 5228				  ffebld_constant_real2 (ffebld_conter (l)),
 5229				 ffebld_constant_real2 (ffebld_conter (r)));
 5230	  expr = ffebld_new_conter_with_orig
 5231	    (ffebld_constant_new_logicaldefault (val), expr);
 5232	  break;
 5233#endif
 5234
 5235#if FFETARGET_okREAL3
 5236	case FFEINFO_kindtypeREAL3:
 5237	  error = ffetarget_ge_real3 (&val,
 5238				  ffebld_constant_real3 (ffebld_conter (l)),
 5239				 ffebld_constant_real3 (ffebld_conter (r)));
 5240	  expr = ffebld_new_conter_with_orig
 5241	    (ffebld_constant_new_logicaldefault (val), expr);
 5242	  break;
 5243#endif
 5244
 5245#if FFETARGET_okREAL4
 5246	case FFEINFO_kindtypeREAL4:
 5247	  error = ffetarget_ge_real4 (&val,
 5248				  ffebld_constant_real4 (ffebld_conter (l)),
 5249				 ffebld_constant_real4 (ffebld_conter (r)));
 5250	  expr = ffebld_new_conter_with_orig
 5251	    (ffebld_constant_new_logicaldefault (val), expr);
 5252	  break;
 5253#endif
 5254
 5255	default:
 5256	  assert ("bad real kind type" == NULL);
 5257	  break;
 5258	}
 5259      break;
 5260
 5261    case FFEINFO_basictypeCHARACTER:
 5262      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5263	{
 5264#if FFETARGET_okCHARACTER1
 5265	case FFEINFO_kindtypeCHARACTER1:
 5266	  error = ffetarget_ge_character1 (&val,
 5267			     ffebld_constant_character1 (ffebld_conter (l)),
 5268			    ffebld_constant_character1 (ffebld_conter (r)));
 5269	  expr = ffebld_new_conter_with_orig
 5270	    (ffebld_constant_new_logicaldefault (val), expr);
 5271	  break;
 5272#endif
 5273
 5274#if FFETARGET_okCHARACTER2
 5275	case FFEINFO_kindtypeCHARACTER2:
 5276	  error = ffetarget_ge_character2 (&val,
 5277			     ffebld_constant_character2 (ffebld_conter (l)),
 5278			    ffebld_constant_character2 (ffebld_conter (r)));
 5279	  expr = ffebld_new_conter_with_orig
 5280	    (ffebld_constant_new_logicaldefault (val), expr);
 5281	  break;
 5282#endif
 5283
 5284#if FFETARGET_okCHARACTER3
 5285	case FFEINFO_kindtypeCHARACTER3:
 5286	  error = ffetarget_ge_character3 (&val,
 5287			     ffebld_constant_character3 (ffebld_conter (l)),
 5288			    ffebld_constant_character3 (ffebld_conter (r)));
 5289	  expr = ffebld_new_conter_with_orig
 5290	    (ffebld_constant_new_logicaldefault (val), expr);
 5291	  break;
 5292#endif
 5293
 5294#if FFETARGET_okCHARACTER4
 5295	case FFEINFO_kindtypeCHARACTER4:
 5296	  error = ffetarget_ge_character4 (&val,
 5297			     ffebld_constant_character4 (ffebld_conter (l)),
 5298			    ffebld_constant_character4 (ffebld_conter (r)));
 5299	  expr = ffebld_new_conter_with_orig
 5300	    (ffebld_constant_new_logicaldefault (val), expr);
 5301	  break;
 5302#endif
 5303
 5304	default:
 5305	  assert ("bad character kind type" == NULL);
 5306	  break;
 5307	}
 5308      break;
 5309
 5310    default:
 5311      assert ("bad type" == NULL);
 5312      return expr;
 5313    }
 5314
 5315  ffebld_set_info (expr, ffeinfo_new
 5316		   (FFEINFO_basictypeLOGICAL,
 5317		    FFEINFO_kindtypeLOGICALDEFAULT,
 5318		    0,
 5319		    FFEINFO_kindENTITY,
 5320		    FFEINFO_whereCONSTANT,
 5321		    FFETARGET_charactersizeNONE));
 5322
 5323  if ((error != FFEBAD)
 5324      && ffebad_start (error))
 5325    {
 5326      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 5327      ffebad_finish ();
 5328    }
 5329
 5330  return expr;
 5331}
 5332
 5333/* ffeexpr_collapse_gt -- Collapse gt expr
 5334
 5335   ffebld expr;
 5336   ffelexToken token;
 5337   expr = ffeexpr_collapse_gt(expr,token);
 5338
 5339   If the result of the expr is a constant, replaces the expr with the
 5340   computed constant.  */
 5341
 5342ffebld
 5343ffeexpr_collapse_gt (ffebld expr, ffelexToken t)
 5344{
 5345  ffebad error = FFEBAD;
 5346  ffebld l;
 5347  ffebld r;
 5348  bool val;
 5349
 5350  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 5351    return expr;
 5352
 5353  l = ffebld_left (expr);
 5354  r = ffebld_right (expr);
 5355
 5356  if (ffebld_op (l) != FFEBLD_opCONTER)
 5357    return expr;
 5358  if (ffebld_op (r) != FFEBLD_opCONTER)
 5359    return expr;
 5360
 5361  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
 5362    {
 5363    case FFEINFO_basictypeANY:
 5364      return expr;
 5365
 5366    case FFEINFO_basictypeINTEGER:
 5367      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5368	{
 5369#if FFETARGET_okINTEGER1
 5370	case FFEINFO_kindtypeINTEGER1:
 5371	  error = ffetarget_gt_integer1 (&val,
 5372			       ffebld_constant_integer1 (ffebld_conter (l)),
 5373			      ffebld_constant_integer1 (ffebld_conter (r)));
 5374	  expr = ffebld_new_conter_with_orig
 5375	    (ffebld_constant_new_logicaldefault (val), expr);
 5376	  break;
 5377#endif
 5378
 5379#if FFETARGET_okINTEGER2
 5380	case FFEINFO_kindtypeINTEGER2:
 5381	  error = ffetarget_gt_integer2 (&val,
 5382			       ffebld_constant_integer2 (ffebld_conter (l)),
 5383			      ffebld_constant_integer2 (ffebld_conter (r)));
 5384	  expr = ffebld_new_conter_with_orig
 5385	    (ffebld_constant_new_logicaldefault (val), expr);
 5386	  break;
 5387#endif
 5388
 5389#if FFETARGET_okINTEGER3
 5390	case FFEINFO_kindtypeINTEGER3:
 5391	  error = ffetarget_gt_integer3 (&val,
 5392			       ffebld_constant_integer3 (ffebld_conter (l)),
 5393			      ffebld_constant_integer3 (ffebld_conter (r)));
 5394	  expr = ffebld_new_conter_with_orig
 5395	    (ffebld_constant_new_logicaldefault (val), expr);
 5396	  break;
 5397#endif
 5398
 5399#if FFETARGET_okINTEGER4
 5400	case FFEINFO_kindtypeINTEGER4:
 5401	  error = ffetarget_gt_integer4 (&val,
 5402			       ffebld_constant_integer4 (ffebld_conter (l)),
 5403			      ffebld_constant_integer4 (ffebld_conter (r)));
 5404	  expr = ffebld_new_conter_with_orig
 5405	    (ffebld_constant_new_logicaldefault (val), expr);
 5406	  break;
 5407#endif
 5408
 5409	default:
 5410	  assert ("bad integer kind type" == NULL);
 5411	  break;
 5412	}
 5413      break;
 5414
 5415    case FFEINFO_basictypeREAL:
 5416      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5417	{
 5418#if FFETARGET_okREAL1
 5419	case FFEINFO_kindtypeREAL1:
 5420	  error = ffetarget_gt_real1 (&val,
 5421				  ffebld_constant_real1 (ffebld_conter (l)),
 5422				 ffebld_constant_real1 (ffebld_conter (r)));
 5423	  expr = ffebld_new_conter_with_orig
 5424	    (ffebld_constant_new_logicaldefault (val), expr);
 5425	  break;
 5426#endif
 5427
 5428#if FFETARGET_okREAL2
 5429	case FFEINFO_kindtypeREAL2:
 5430	  error = ffetarget_gt_real2 (&val,
 5431				  ffebld_constant_real2 (ffebld_conter (l)),
 5432				 ffebld_constant_real2 (ffebld_conter (r)));
 5433	  expr = ffebld_new_conter_with_orig
 5434	    (ffebld_constant_new_logicaldefault (val), expr);
 5435	  break;
 5436#endif
 5437
 5438#if FFETARGET_okREAL3
 5439	case FFEINFO_kindtypeREAL3:
 5440	  error = ffetarget_gt_real3 (&val,
 5441				  ffebld_constant_real3 (ffebld_conter (l)),
 5442				 ffebld_constant_real3 (ffebld_conter (r)));
 5443	  expr = ffebld_new_conter_with_orig
 5444	    (ffebld_constant_new_logicaldefault (val), expr);
 5445	  break;
 5446#endif
 5447
 5448#if FFETARGET_okREAL4
 5449	case FFEINFO_kindtypeREAL4:
 5450	  error = ffetarget_gt_real4 (&val,
 5451				  ffebld_constant_real4 (ffebld_conter (l)),
 5452				 ffebld_constant_real4 (ffebld_conter (r)));
 5453	  expr = ffebld_new_conter_with_orig
 5454	    (ffebld_constant_new_logicaldefault (val), expr);
 5455	  break;
 5456#endif
 5457
 5458	default:
 5459	  assert ("bad real kind type" == NULL);
 5460	  break;
 5461	}
 5462      break;
 5463
 5464    case FFEINFO_basictypeCHARACTER:
 5465      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5466	{
 5467#if FFETARGET_okCHARACTER1
 5468	case FFEINFO_kindtypeCHARACTER1:
 5469	  error = ffetarget_gt_character1 (&val,
 5470			     ffebld_constant_character1 (ffebld_conter (l)),
 5471			    ffebld_constant_character1 (ffebld_conter (r)));
 5472	  expr = ffebld_new_conter_with_orig
 5473	    (ffebld_constant_new_logicaldefault (val), expr);
 5474	  break;
 5475#endif
 5476
 5477#if FFETARGET_okCHARACTER2
 5478	case FFEINFO_kindtypeCHARACTER2:
 5479	  error = ffetarget_gt_character2 (&val,
 5480			     ffebld_constant_character2 (ffebld_conter (l)),
 5481			    ffebld_constant_character2 (ffebld_conter (r)));
 5482	  expr = ffebld_new_conter_with_orig
 5483	    (ffebld_constant_new_logicaldefault (val), expr);
 5484	  break;
 5485#endif
 5486
 5487#if FFETARGET_okCHARACTER3
 5488	case FFEINFO_kindtypeCHARACTER3:
 5489	  error = ffetarget_gt_character3 (&val,
 5490			     ffebld_constant_character3 (ffebld_conter (l)),
 5491			    ffebld_constant_character3 (ffebld_conter (r)));
 5492	  expr = ffebld_new_conter_with_orig
 5493	    (ffebld_constant_new_logicaldefault (val), expr);
 5494	  break;
 5495#endif
 5496
 5497#if FFETARGET_okCHARACTER4
 5498	case FFEINFO_kindtypeCHARACTER4:
 5499	  error = ffetarget_gt_character4 (&val,
 5500			     ffebld_constant_character4 (ffebld_conter (l)),
 5501			    ffebld_constant_character4 (ffebld_conter (r)));
 5502	  expr = ffebld_new_conter_with_orig
 5503	    (ffebld_constant_new_logicaldefault (val), expr);
 5504	  break;
 5505#endif
 5506
 5507	default:
 5508	  assert ("bad character kind type" == NULL);
 5509	  break;
 5510	}
 5511      break;
 5512
 5513    default:
 5514      assert ("bad type" == NULL);
 5515      return expr;
 5516    }
 5517
 5518  ffebld_set_info (expr, ffeinfo_new
 5519		   (FFEINFO_basictypeLOGICAL,
 5520		    FFEINFO_kindtypeLOGICALDEFAULT,
 5521		    0,
 5522		    FFEINFO_kindENTITY,
 5523		    FFEINFO_whereCONSTANT,
 5524		    FFETARGET_charactersizeNONE));
 5525
 5526  if ((error != FFEBAD)
 5527      && ffebad_start (error))
 5528    {
 5529      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 5530      ffebad_finish ();
 5531    }
 5532
 5533  return expr;
 5534}
 5535
 5536/* ffeexpr_collapse_le -- Collapse le expr
 5537
 5538   ffebld expr;
 5539   ffelexToken token;
 5540   expr = ffeexpr_collapse_le(expr,token);
 5541
 5542   If the result of the expr is a constant, replaces the expr with the
 5543   computed constant.  */
 5544
 5545ffebld
 5546ffeexpr_collapse_le (ffebld expr, ffelexToken t)
 5547{
 5548  ffebad error = FFEBAD;
 5549  ffebld l;
 5550  ffebld r;
 5551  bool val;
 5552
 5553  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 5554    return expr;
 5555
 5556  l = ffebld_left (expr);
 5557  r = ffebld_right (expr);
 5558
 5559  if (ffebld_op (l) != FFEBLD_opCONTER)
 5560    return expr;
 5561  if (ffebld_op (r) != FFEBLD_opCONTER)
 5562    return expr;
 5563
 5564  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
 5565    {
 5566    case FFEINFO_basictypeANY:
 5567      return expr;
 5568
 5569    case FFEINFO_basictypeINTEGER:
 5570      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5571	{
 5572#if FFETARGET_okINTEGER1
 5573	case FFEINFO_kindtypeINTEGER1:
 5574	  error = ffetarget_le_integer1 (&val,
 5575			       ffebld_constant_integer1 (ffebld_conter (l)),
 5576			      ffebld_constant_integer1 (ffebld_conter (r)));
 5577	  expr = ffebld_new_conter_with_orig
 5578	    (ffebld_constant_new_logicaldefault (val), expr);
 5579	  break;
 5580#endif
 5581
 5582#if FFETARGET_okINTEGER2
 5583	case FFEINFO_kindtypeINTEGER2:
 5584	  error = ffetarget_le_integer2 (&val,
 5585			       ffebld_constant_integer2 (ffebld_conter (l)),
 5586			      ffebld_constant_integer2 (ffebld_conter (r)));
 5587	  expr = ffebld_new_conter_with_orig
 5588	    (ffebld_constant_new_logicaldefault (val), expr);
 5589	  break;
 5590#endif
 5591
 5592#if FFETARGET_okINTEGER3
 5593	case FFEINFO_kindtypeINTEGER3:
 5594	  error = ffetarget_le_integer3 (&val,
 5595			       ffebld_constant_integer3 (ffebld_conter (l)),
 5596			      ffebld_constant_integer3 (ffebld_conter (r)));
 5597	  expr = ffebld_new_conter_with_orig
 5598	    (ffebld_constant_new_logicaldefault (val), expr);
 5599	  break;
 5600#endif
 5601
 5602#if FFETARGET_okINTEGER4
 5603	case FFEINFO_kindtypeINTEGER4:
 5604	  error = ffetarget_le_integer4 (&val,
 5605			       ffebld_constant_integer4 (ffebld_conter (l)),
 5606			      ffebld_constant_integer4 (ffebld_conter (r)));
 5607	  expr = ffebld_new_conter_with_orig
 5608	    (ffebld_constant_new_logicaldefault (val), expr);
 5609	  break;
 5610#endif
 5611
 5612	default:
 5613	  assert ("bad integer kind type" == NULL);
 5614	  break;
 5615	}
 5616      break;
 5617
 5618    case FFEINFO_basictypeREAL:
 5619      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5620	{
 5621#if FFETARGET_okREAL1
 5622	case FFEINFO_kindtypeREAL1:
 5623	  error = ffetarget_le_real1 (&val,
 5624				  ffebld_constant_real1 (ffebld_conter (l)),
 5625				 ffebld_constant_real1 (ffebld_conter (r)));
 5626	  expr = ffebld_new_conter_with_orig
 5627	    (ffebld_constant_new_logicaldefault (val), expr);
 5628	  break;
 5629#endif
 5630
 5631#if FFETARGET_okREAL2
 5632	case FFEINFO_kindtypeREAL2:
 5633	  error = ffetarget_le_real2 (&val,
 5634				  ffebld_constant_real2 (ffebld_conter (l)),
 5635				 ffebld_constant_real2 (ffebld_conter (r)));
 5636	  expr = ffebld_new_conter_with_orig
 5637	    (ffebld_constant_new_logicaldefault (val), expr);
 5638	  break;
 5639#endif
 5640
 5641#if FFETARGET_okREAL3
 5642	case FFEINFO_kindtypeREAL3:
 5643	  error = ffetarget_le_real3 (&val,
 5644				  ffebld_constant_real3 (ffebld_conter (l)),
 5645				 ffebld_constant_real3 (ffebld_conter (r)));
 5646	  expr = ffebld_new_conter_with_orig
 5647	    (ffebld_constant_new_logicaldefault (val), expr);
 5648	  break;
 5649#endif
 5650
 5651#if FFETARGET_okREAL4
 5652	case FFEINFO_kindtypeREAL4:
 5653	  error = ffetarget_le_real4 (&val,
 5654				  ffebld_constant_real4 (ffebld_conter (l)),
 5655				 ffebld_constant_real4 (ffebld_conter (r)));
 5656	  expr = ffebld_new_conter_with_orig
 5657	    (ffebld_constant_new_logicaldefault (val), expr);
 5658	  break;
 5659#endif
 5660
 5661	default:
 5662	  assert ("bad real kind type" == NULL);
 5663	  break;
 5664	}
 5665      break;
 5666
 5667    case FFEINFO_basictypeCHARACTER:
 5668      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5669	{
 5670#if FFETARGET_okCHARACTER1
 5671	case FFEINFO_kindtypeCHARACTER1:
 5672	  error = ffetarget_le_character1 (&val,
 5673			     ffebld_constant_character1 (ffebld_conter (l)),
 5674			    ffebld_constant_character1 (ffebld_conter (r)));
 5675	  expr = ffebld_new_conter_with_orig
 5676	    (ffebld_constant_new_logicaldefault (val), expr);
 5677	  break;
 5678#endif
 5679
 5680#if FFETARGET_okCHARACTER2
 5681	case FFEINFO_kindtypeCHARACTER2:
 5682	  error = ffetarget_le_character2 (&val,
 5683			     ffebld_constant_character2 (ffebld_conter (l)),
 5684			    ffebld_constant_character2 (ffebld_conter (r)));
 5685	  expr = ffebld_new_conter_with_orig
 5686	    (ffebld_constant_new_logicaldefault (val), expr);
 5687	  break;
 5688#endif
 5689
 5690#if FFETARGET_okCHARACTER3
 5691	case FFEINFO_kindtypeCHARACTER3:
 5692	  error = ffetarget_le_character3 (&val,
 5693			     ffebld_constant_character3 (ffebld_conter (l)),
 5694			    ffebld_constant_character3 (ffebld_conter (r)));
 5695	  expr = ffebld_new_conter_with_orig
 5696	    (ffebld_constant_new_logicaldefault (val), expr);
 5697	  break;
 5698#endif
 5699
 5700#if FFETARGET_okCHARACTER4
 5701	case FFEINFO_kindtypeCHARACTER4:
 5702	  error = ffetarget_le_character4 (&val,
 5703			     ffebld_constant_character4 (ffebld_conter (l)),
 5704			    ffebld_constant_character4 (ffebld_conter (r)));
 5705	  expr = ffebld_new_conter_with_orig
 5706	    (ffebld_constant_new_logicaldefault (val), expr);
 5707	  break;
 5708#endif
 5709
 5710	default:
 5711	  assert ("bad character kind type" == NULL);
 5712	  break;
 5713	}
 5714      break;
 5715
 5716    default:
 5717      assert ("bad type" == NULL);
 5718      return expr;
 5719    }
 5720
 5721  ffebld_set_info (expr, ffeinfo_new
 5722		   (FFEINFO_basictypeLOGICAL,
 5723		    FFEINFO_kindtypeLOGICALDEFAULT,
 5724		    0,
 5725		    FFEINFO_kindENTITY,
 5726		    FFEINFO_whereCONSTANT,
 5727		    FFETARGET_charactersizeNONE));
 5728
 5729  if ((error != FFEBAD)
 5730      && ffebad_start (error))
 5731    {
 5732      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 5733      ffebad_finish ();
 5734    }
 5735
 5736  return expr;
 5737}
 5738
 5739/* ffeexpr_collapse_lt -- Collapse lt expr
 5740
 5741   ffebld expr;
 5742   ffelexToken token;
 5743   expr = ffeexpr_collapse_lt(expr,token);
 5744
 5745   If the result of the expr is a constant, replaces the expr with the
 5746   computed constant.  */
 5747
 5748ffebld
 5749ffeexpr_collapse_lt (ffebld expr, ffelexToken t)
 5750{
 5751  ffebad error = FFEBAD;
 5752  ffebld l;
 5753  ffebld r;
 5754  bool val;
 5755
 5756  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 5757    return expr;
 5758
 5759  l = ffebld_left (expr);
 5760  r = ffebld_right (expr);
 5761
 5762  if (ffebld_op (l) != FFEBLD_opCONTER)
 5763    return expr;
 5764  if (ffebld_op (r) != FFEBLD_opCONTER)
 5765    return expr;
 5766
 5767  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
 5768    {
 5769    case FFEINFO_basictypeANY:
 5770      return expr;
 5771
 5772    case FFEINFO_basictypeINTEGER:
 5773      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5774	{
 5775#if FFETARGET_okINTEGER1
 5776	case FFEINFO_kindtypeINTEGER1:
 5777	  error = ffetarget_lt_integer1 (&val,
 5778			       ffebld_constant_integer1 (ffebld_conter (l)),
 5779			      ffebld_constant_integer1 (ffebld_conter (r)));
 5780	  expr = ffebld_new_conter_with_orig
 5781	    (ffebld_constant_new_logicaldefault (val), expr);
 5782	  break;
 5783#endif
 5784
 5785#if FFETARGET_okINTEGER2
 5786	case FFEINFO_kindtypeINTEGER2:
 5787	  error = ffetarget_lt_integer2 (&val,
 5788			       ffebld_constant_integer2 (ffebld_conter (l)),
 5789			      ffebld_constant_integer2 (ffebld_conter (r)));
 5790	  expr = ffebld_new_conter_with_orig
 5791	    (ffebld_constant_new_logicaldefault (val), expr);
 5792	  break;
 5793#endif
 5794
 5795#if FFETARGET_okINTEGER3
 5796	case FFEINFO_kindtypeINTEGER3:
 5797	  error = ffetarget_lt_integer3 (&val,
 5798			       ffebld_constant_integer3 (ffebld_conter (l)),
 5799			      ffebld_constant_integer3 (ffebld_conter (r)));
 5800	  expr = ffebld_new_conter_with_orig
 5801	    (ffebld_constant_new_logicaldefault (val), expr);
 5802	  break;
 5803#endif
 5804
 5805#if FFETARGET_okINTEGER4
 5806	case FFEINFO_kindtypeINTEGER4:
 5807	  error = ffetarget_lt_integer4 (&val,
 5808			       ffebld_constant_integer4 (ffebld_conter (l)),
 5809			      ffebld_constant_integer4 (ffebld_conter (r)));
 5810	  expr = ffebld_new_conter_with_orig
 5811	    (ffebld_constant_new_logicaldefault (val), expr);
 5812	  break;
 5813#endif
 5814
 5815	default:
 5816	  assert ("bad integer kind type" == NULL);
 5817	  break;
 5818	}
 5819      break;
 5820
 5821    case FFEINFO_basictypeREAL:
 5822      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5823	{
 5824#if FFETARGET_okREAL1
 5825	case FFEINFO_kindtypeREAL1:
 5826	  error = ffetarget_lt_real1 (&val,
 5827				  ffebld_constant_real1 (ffebld_conter (l)),
 5828				 ffebld_constant_real1 (ffebld_conter (r)));
 5829	  expr = ffebld_new_conter_with_orig
 5830	    (ffebld_constant_new_logicaldefault (val), expr);
 5831	  break;
 5832#endif
 5833
 5834#if FFETARGET_okREAL2
 5835	case FFEINFO_kindtypeREAL2:
 5836	  error = ffetarget_lt_real2 (&val,
 5837				  ffebld_constant_real2 (ffebld_conter (l)),
 5838				 ffebld_constant_real2 (ffebld_conter (r)));
 5839	  expr = ffebld_new_conter_with_orig
 5840	    (ffebld_constant_new_logicaldefault (val), expr);
 5841	  break;
 5842#endif
 5843
 5844#if FFETARGET_okREAL3
 5845	case FFEINFO_kindtypeREAL3:
 5846	  error = ffetarget_lt_real3 (&val,
 5847				  ffebld_constant_real3 (ffebld_conter (l)),
 5848				 ffebld_constant_real3 (ffebld_conter (r)));
 5849	  expr = ffebld_new_conter_with_orig
 5850	    (ffebld_constant_new_logicaldefault (val), expr);
 5851	  break;
 5852#endif
 5853
 5854#if FFETARGET_okREAL4
 5855	case FFEINFO_kindtypeREAL4:
 5856	  error = ffetarget_lt_real4 (&val,
 5857				  ffebld_constant_real4 (ffebld_conter (l)),
 5858				 ffebld_constant_real4 (ffebld_conter (r)));
 5859	  expr = ffebld_new_conter_with_orig
 5860	    (ffebld_constant_new_logicaldefault (val), expr);
 5861	  break;
 5862#endif
 5863
 5864	default:
 5865	  assert ("bad real kind type" == NULL);
 5866	  break;
 5867	}
 5868      break;
 5869
 5870    case FFEINFO_basictypeCHARACTER:
 5871      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
 5872	{
 5873#if FFETARGET_okCHARACTER1
 5874	case FFEINFO_kindtypeCHARACTER1:
 5875	  error = ffetarget_lt_character1 (&val,
 5876			     ffebld_constant_character1 (ffebld_conter (l)),
 5877			    ffebld_constant_character1 (ffebld_conter (r)));
 5878	  expr = ffebld_new_conter_with_orig
 5879	    (ffebld_constant_new_logicaldefault (val), expr);
 5880	  break;
 5881#endif
 5882
 5883#if FFETARGET_okCHARACTER2
 5884	case FFEINFO_kindtypeCHARACTER2:
 5885	  error = ffetarget_lt_character2 (&val,
 5886			     ffebld_constant_character2 (ffebld_conter (l)),
 5887			    ffebld_constant_character2 (ffebld_conter (r)));
 5888	  expr = ffebld_new_conter_with_orig
 5889	    (ffebld_constant_new_logicaldefault (val), expr);
 5890	  break;
 5891#endif
 5892
 5893#if FFETARGET_okCHARACTER3
 5894	case FFEINFO_kindtypeCHARACTER3:
 5895	  error = ffetarget_lt_character3 (&val,
 5896			     ffebld_constant_character3 (ffebld_conter (l)),
 5897			    ffebld_constant_character3 (ffebld_conter (r)));
 5898	  expr = ffebld_new_conter_with_orig
 5899	    (ffebld_constant_new_logicaldefault (val), expr);
 5900	  break;
 5901#endif
 5902
 5903#if FFETARGET_okCHARACTER4
 5904	case FFEINFO_kindtypeCHARACTER4:
 5905	  error = ffetarget_lt_character4 (&val,
 5906			     ffebld_constant_character4 (ffebld_conter (l)),
 5907			    ffebld_constant_character4 (ffebld_conter (r)));
 5908	  expr = ffebld_new_conter_with_orig
 5909	    (ffebld_constant_new_logicaldefault (val), expr);
 5910	  break;
 5911#endif
 5912
 5913	default:
 5914	  assert ("bad character kind type" == NULL);
 5915	  break;
 5916	}
 5917      break;
 5918
 5919    default:
 5920      assert ("bad type" == NULL);
 5921      return expr;
 5922    }
 5923
 5924  ffebld_set_info (expr, ffeinfo_new
 5925		   (FFEINFO_basictypeLOGICAL,
 5926		    FFEINFO_kindtypeLOGICALDEFAULT,
 5927		    0,
 5928		    FFEINFO_kindENTITY,
 5929		    FFEINFO_whereCONSTANT,
 5930		    FFETARGET_charactersizeNONE));
 5931
 5932  if ((error != FFEBAD)
 5933      && ffebad_start (error))
 5934    {
 5935      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 5936      ffebad_finish ();
 5937    }
 5938
 5939  return expr;
 5940}
 5941
 5942/* ffeexpr_collapse_and -- Collapse and expr
 5943
 5944   ffebld expr;
 5945   ffelexToken token;
 5946   expr = ffeexpr_collapse_and(expr,token);
 5947
 5948   If the result of the expr is a constant, replaces the expr with the
 5949   computed constant.  */
 5950
 5951ffebld
 5952ffeexpr_collapse_and (ffebld expr, ffelexToken t)
 5953{
 5954  ffebad error = FFEBAD;
 5955  ffebld l;
 5956  ffebld r;
 5957  ffebldConstantUnion u;
 5958  ffeinfoBasictype bt;
 5959  ffeinfoKindtype kt;
 5960
 5961  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 5962    return expr;
 5963
 5964  l = ffebld_left (expr);
 5965  r = ffebld_right (expr);
 5966
 5967  if (ffebld_op (l) != FFEBLD_opCONTER)
 5968    return expr;
 5969  if (ffebld_op (r) != FFEBLD_opCONTER)
 5970    return expr;
 5971
 5972  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 5973    {
 5974    case FFEINFO_basictypeANY:
 5975      return expr;
 5976
 5977    case FFEINFO_basictypeINTEGER:
 5978      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 5979	{
 5980#if FFETARGET_okINTEGER1
 5981	case FFEINFO_kindtypeINTEGER1:
 5982	  error = ffetarget_and_integer1 (ffebld_cu_ptr_integer1 (u),
 5983			       ffebld_constant_integer1 (ffebld_conter (l)),
 5984			      ffebld_constant_integer1 (ffebld_conter (r)));
 5985	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 5986					(ffebld_cu_val_integer1 (u)), expr);
 5987	  break;
 5988#endif
 5989
 5990#if FFETARGET_okINTEGER2
 5991	case FFEINFO_kindtypeINTEGER2:
 5992	  error = ffetarget_and_integer2 (ffebld_cu_ptr_integer2 (u),
 5993			       ffebld_constant_integer2 (ffebld_conter (l)),
 5994			      ffebld_constant_integer2 (ffebld_conter (r)));
 5995	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 5996					(ffebld_cu_val_integer2 (u)), expr);
 5997	  break;
 5998#endif
 5999
 6000#if FFETARGET_okINTEGER3
 6001	case FFEINFO_kindtypeINTEGER3:
 6002	  error = ffetarget_and_integer3 (ffebld_cu_ptr_integer3 (u),
 6003			       ffebld_constant_integer3 (ffebld_conter (l)),
 6004			      ffebld_constant_integer3 (ffebld_conter (r)));
 6005	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 6006					(ffebld_cu_val_integer3 (u)), expr);
 6007	  break;
 6008#endif
 6009
 6010#if FFETARGET_okINTEGER4
 6011	case FFEINFO_kindtypeINTEGER4:
 6012	  error = ffetarget_and_integer4 (ffebld_cu_ptr_integer4 (u),
 6013			       ffebld_constant_integer4 (ffebld_conter (l)),
 6014			      ffebld_constant_integer4 (ffebld_conter (r)));
 6015	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 6016					(ffebld_cu_val_integer4 (u)), expr);
 6017	  break;
 6018#endif
 6019
 6020	default:
 6021	  assert ("bad integer kind type" == NULL);
 6022	  break;
 6023	}
 6024      break;
 6025
 6026    case FFEINFO_basictypeLOGICAL:
 6027      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6028	{
 6029#if FFETARGET_okLOGICAL1
 6030	case FFEINFO_kindtypeLOGICAL1:
 6031	  error = ffetarget_and_logical1 (ffebld_cu_ptr_logical1 (u),
 6032			       ffebld_constant_logical1 (ffebld_conter (l)),
 6033			      ffebld_constant_logical1 (ffebld_conter (r)));
 6034	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
 6035					(ffebld_cu_val_logical1 (u)), expr);
 6036	  break;
 6037#endif
 6038
 6039#if FFETARGET_okLOGICAL2
 6040	case FFEINFO_kindtypeLOGICAL2:
 6041	  error = ffetarget_and_logical2 (ffebld_cu_ptr_logical2 (u),
 6042			       ffebld_constant_logical2 (ffebld_conter (l)),
 6043			      ffebld_constant_logical2 (ffebld_conter (r)));
 6044	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
 6045					(ffebld_cu_val_logical2 (u)), expr);
 6046	  break;
 6047#endif
 6048
 6049#if FFETARGET_okLOGICAL3
 6050	case FFEINFO_kindtypeLOGICAL3:
 6051	  error = ffetarget_and_logical3 (ffebld_cu_ptr_logical3 (u),
 6052			       ffebld_constant_logical3 (ffebld_conter (l)),
 6053			      ffebld_constant_logical3 (ffebld_conter (r)));
 6054	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
 6055					(ffebld_cu_val_logical3 (u)), expr);
 6056	  break;
 6057#endif
 6058
 6059#if FFETARGET_okLOGICAL4
 6060	case FFEINFO_kindtypeLOGICAL4:
 6061	  error = ffetarget_and_logical4 (ffebld_cu_ptr_logical4 (u),
 6062			       ffebld_constant_logical4 (ffebld_conter (l)),
 6063			      ffebld_constant_logical4 (ffebld_conter (r)));
 6064	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
 6065					(ffebld_cu_val_logical4 (u)), expr);
 6066	  break;
 6067#endif
 6068
 6069	default:
 6070	  assert ("bad logical kind type" == NULL);
 6071	  break;
 6072	}
 6073      break;
 6074
 6075    default:
 6076      assert ("bad type" == NULL);
 6077      return expr;
 6078    }
 6079
 6080  ffebld_set_info (expr, ffeinfo_new
 6081		   (bt,
 6082		    kt,
 6083		    0,
 6084		    FFEINFO_kindENTITY,
 6085		    FFEINFO_whereCONSTANT,
 6086		    FFETARGET_charactersizeNONE));
 6087
 6088  if ((error != FFEBAD)
 6089      && ffebad_start (error))
 6090    {
 6091      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 6092      ffebad_finish ();
 6093    }
 6094
 6095  return expr;
 6096}
 6097
 6098/* ffeexpr_collapse_or -- Collapse or expr
 6099
 6100   ffebld expr;
 6101   ffelexToken token;
 6102   expr = ffeexpr_collapse_or(expr,token);
 6103
 6104   If the result of the expr is a constant, replaces the expr with the
 6105   computed constant.  */
 6106
 6107ffebld
 6108ffeexpr_collapse_or (ffebld expr, ffelexToken t)
 6109{
 6110  ffebad error = FFEBAD;
 6111  ffebld l;
 6112  ffebld r;
 6113  ffebldConstantUnion u;
 6114  ffeinfoBasictype bt;
 6115  ffeinfoKindtype kt;
 6116
 6117  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 6118    return expr;
 6119
 6120  l = ffebld_left (expr);
 6121  r = ffebld_right (expr);
 6122
 6123  if (ffebld_op (l) != FFEBLD_opCONTER)
 6124    return expr;
 6125  if (ffebld_op (r) != FFEBLD_opCONTER)
 6126    return expr;
 6127
 6128  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 6129    {
 6130    case FFEINFO_basictypeANY:
 6131      return expr;
 6132
 6133    case FFEINFO_basictypeINTEGER:
 6134      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6135	{
 6136#if FFETARGET_okINTEGER1
 6137	case FFEINFO_kindtypeINTEGER1:
 6138	  error = ffetarget_or_integer1 (ffebld_cu_ptr_integer1 (u),
 6139			       ffebld_constant_integer1 (ffebld_conter (l)),
 6140			      ffebld_constant_integer1 (ffebld_conter (r)));
 6141	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 6142					(ffebld_cu_val_integer1 (u)), expr);
 6143	  break;
 6144#endif
 6145
 6146#if FFETARGET_okINTEGER2
 6147	case FFEINFO_kindtypeINTEGER2:
 6148	  error = ffetarget_or_integer2 (ffebld_cu_ptr_integer2 (u),
 6149			       ffebld_constant_integer2 (ffebld_conter (l)),
 6150			      ffebld_constant_integer2 (ffebld_conter (r)));
 6151	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 6152					(ffebld_cu_val_integer2 (u)), expr);
 6153	  break;
 6154#endif
 6155
 6156#if FFETARGET_okINTEGER3
 6157	case FFEINFO_kindtypeINTEGER3:
 6158	  error = ffetarget_or_integer3 (ffebld_cu_ptr_integer3 (u),
 6159			       ffebld_constant_integer3 (ffebld_conter (l)),
 6160			      ffebld_constant_integer3 (ffebld_conter (r)));
 6161	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 6162					(ffebld_cu_val_integer3 (u)), expr);
 6163	  break;
 6164#endif
 6165
 6166#if FFETARGET_okINTEGER4
 6167	case FFEINFO_kindtypeINTEGER4:
 6168	  error = ffetarget_or_integer4 (ffebld_cu_ptr_integer4 (u),
 6169			       ffebld_constant_integer4 (ffebld_conter (l)),
 6170			      ffebld_constant_integer4 (ffebld_conter (r)));
 6171	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 6172					(ffebld_cu_val_integer4 (u)), expr);
 6173	  break;
 6174#endif
 6175
 6176	default:
 6177	  assert ("bad integer kind type" == NULL);
 6178	  break;
 6179	}
 6180      break;
 6181
 6182    case FFEINFO_basictypeLOGICAL:
 6183      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6184	{
 6185#if FFETARGET_okLOGICAL1
 6186	case FFEINFO_kindtypeLOGICAL1:
 6187	  error = ffetarget_or_logical1 (ffebld_cu_ptr_logical1 (u),
 6188			       ffebld_constant_logical1 (ffebld_conter (l)),
 6189			      ffebld_constant_logical1 (ffebld_conter (r)));
 6190	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
 6191					(ffebld_cu_val_logical1 (u)), expr);
 6192	  break;
 6193#endif
 6194
 6195#if FFETARGET_okLOGICAL2
 6196	case FFEINFO_kindtypeLOGICAL2:
 6197	  error = ffetarget_or_logical2 (ffebld_cu_ptr_logical2 (u),
 6198			       ffebld_constant_logical2 (ffebld_conter (l)),
 6199			      ffebld_constant_logical2 (ffebld_conter (r)));
 6200	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
 6201					(ffebld_cu_val_logical2 (u)), expr);
 6202	  break;
 6203#endif
 6204
 6205#if FFETARGET_okLOGICAL3
 6206	case FFEINFO_kindtypeLOGICAL3:
 6207	  error = ffetarget_or_logical3 (ffebld_cu_ptr_logical3 (u),
 6208			       ffebld_constant_logical3 (ffebld_conter (l)),
 6209			      ffebld_constant_logical3 (ffebld_conter (r)));
 6210	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
 6211					(ffebld_cu_val_logical3 (u)), expr);
 6212	  break;
 6213#endif
 6214
 6215#if FFETARGET_okLOGICAL4
 6216	case FFEINFO_kindtypeLOGICAL4:
 6217	  error = ffetarget_or_logical4 (ffebld_cu_ptr_logical4 (u),
 6218			       ffebld_constant_logical4 (ffebld_conter (l)),
 6219			      ffebld_constant_logical4 (ffebld_conter (r)));
 6220	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
 6221					(ffebld_cu_val_logical4 (u)), expr);
 6222	  break;
 6223#endif
 6224
 6225	default:
 6226	  assert ("bad logical kind type" == NULL);
 6227	  break;
 6228	}
 6229      break;
 6230
 6231    default:
 6232      assert ("bad type" == NULL);
 6233      return expr;
 6234    }
 6235
 6236  ffebld_set_info (expr, ffeinfo_new
 6237		   (bt,
 6238		    kt,
 6239		    0,
 6240		    FFEINFO_kindENTITY,
 6241		    FFEINFO_whereCONSTANT,
 6242		    FFETARGET_charactersizeNONE));
 6243
 6244  if ((error != FFEBAD)
 6245      && ffebad_start (error))
 6246    {
 6247      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 6248      ffebad_finish ();
 6249    }
 6250
 6251  return expr;
 6252}
 6253
 6254/* ffeexpr_collapse_xor -- Collapse xor expr
 6255
 6256   ffebld expr;
 6257   ffelexToken token;
 6258   expr = ffeexpr_collapse_xor(expr,token);
 6259
 6260   If the result of the expr is a constant, replaces the expr with the
 6261   computed constant.  */
 6262
 6263ffebld
 6264ffeexpr_collapse_xor (ffebld expr, ffelexToken t)
 6265{
 6266  ffebad error = FFEBAD;
 6267  ffebld l;
 6268  ffebld r;
 6269  ffebldConstantUnion u;
 6270  ffeinfoBasictype bt;
 6271  ffeinfoKindtype kt;
 6272
 6273  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 6274    return expr;
 6275
 6276  l = ffebld_left (expr);
 6277  r = ffebld_right (expr);
 6278
 6279  if (ffebld_op (l) != FFEBLD_opCONTER)
 6280    return expr;
 6281  if (ffebld_op (r) != FFEBLD_opCONTER)
 6282    return expr;
 6283
 6284  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 6285    {
 6286    case FFEINFO_basictypeANY:
 6287      return expr;
 6288
 6289    case FFEINFO_basictypeINTEGER:
 6290      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6291	{
 6292#if FFETARGET_okINTEGER1
 6293	case FFEINFO_kindtypeINTEGER1:
 6294	  error = ffetarget_xor_integer1 (ffebld_cu_ptr_integer1 (u),
 6295			       ffebld_constant_integer1 (ffebld_conter (l)),
 6296			      ffebld_constant_integer1 (ffebld_conter (r)));
 6297	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 6298					(ffebld_cu_val_integer1 (u)), expr);
 6299	  break;
 6300#endif
 6301
 6302#if FFETARGET_okINTEGER2
 6303	case FFEINFO_kindtypeINTEGER2:
 6304	  error = ffetarget_xor_integer2 (ffebld_cu_ptr_integer2 (u),
 6305			       ffebld_constant_integer2 (ffebld_conter (l)),
 6306			      ffebld_constant_integer2 (ffebld_conter (r)));
 6307	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 6308					(ffebld_cu_val_integer2 (u)), expr);
 6309	  break;
 6310#endif
 6311
 6312#if FFETARGET_okINTEGER3
 6313	case FFEINFO_kindtypeINTEGER3:
 6314	  error = ffetarget_xor_integer3 (ffebld_cu_ptr_integer3 (u),
 6315			       ffebld_constant_integer3 (ffebld_conter (l)),
 6316			      ffebld_constant_integer3 (ffebld_conter (r)));
 6317	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 6318					(ffebld_cu_val_integer3 (u)), expr);
 6319	  break;
 6320#endif
 6321
 6322#if FFETARGET_okINTEGER4
 6323	case FFEINFO_kindtypeINTEGER4:
 6324	  error = ffetarget_xor_integer4 (ffebld_cu_ptr_integer4 (u),
 6325			       ffebld_constant_integer4 (ffebld_conter (l)),
 6326			      ffebld_constant_integer4 (ffebld_conter (r)));
 6327	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 6328					(ffebld_cu_val_integer4 (u)), expr);
 6329	  break;
 6330#endif
 6331
 6332	default:
 6333	  assert ("bad integer kind type" == NULL);
 6334	  break;
 6335	}
 6336      break;
 6337
 6338    case FFEINFO_basictypeLOGICAL:
 6339      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6340	{
 6341#if FFETARGET_okLOGICAL1
 6342	case FFEINFO_kindtypeLOGICAL1:
 6343	  error = ffetarget_xor_logical1 (ffebld_cu_ptr_logical1 (u),
 6344			       ffebld_constant_logical1 (ffebld_conter (l)),
 6345			      ffebld_constant_logical1 (ffebld_conter (r)));
 6346	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
 6347					(ffebld_cu_val_logical1 (u)), expr);
 6348	  break;
 6349#endif
 6350
 6351#if FFETARGET_okLOGICAL2
 6352	case FFEINFO_kindtypeLOGICAL2:
 6353	  error = ffetarget_xor_logical2 (ffebld_cu_ptr_logical2 (u),
 6354			       ffebld_constant_logical2 (ffebld_conter (l)),
 6355			      ffebld_constant_logical2 (ffebld_conter (r)));
 6356	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
 6357					(ffebld_cu_val_logical2 (u)), expr);
 6358	  break;
 6359#endif
 6360
 6361#if FFETARGET_okLOGICAL3
 6362	case FFEINFO_kindtypeLOGICAL3:
 6363	  error = ffetarget_xor_logical3 (ffebld_cu_ptr_logical3 (u),
 6364			       ffebld_constant_logical3 (ffebld_conter (l)),
 6365			      ffebld_constant_logical3 (ffebld_conter (r)));
 6366	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
 6367					(ffebld_cu_val_logical3 (u)), expr);
 6368	  break;
 6369#endif
 6370
 6371#if FFETARGET_okLOGICAL4
 6372	case FFEINFO_kindtypeLOGICAL4:
 6373	  error = ffetarget_xor_logical4 (ffebld_cu_ptr_logical4 (u),
 6374			       ffebld_constant_logical4 (ffebld_conter (l)),
 6375			      ffebld_constant_logical4 (ffebld_conter (r)));
 6376	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
 6377					(ffebld_cu_val_logical4 (u)), expr);
 6378	  break;
 6379#endif
 6380
 6381	default:
 6382	  assert ("bad logical kind type" == NULL);
 6383	  break;
 6384	}
 6385      break;
 6386
 6387    default:
 6388      assert ("bad type" == NULL);
 6389      return expr;
 6390    }
 6391
 6392  ffebld_set_info (expr, ffeinfo_new
 6393		   (bt,
 6394		    kt,
 6395		    0,
 6396		    FFEINFO_kindENTITY,
 6397		    FFEINFO_whereCONSTANT,
 6398		    FFETARGET_charactersizeNONE));
 6399
 6400  if ((error != FFEBAD)
 6401      && ffebad_start (error))
 6402    {
 6403      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 6404      ffebad_finish ();
 6405    }
 6406
 6407  return expr;
 6408}
 6409
 6410/* ffeexpr_collapse_eqv -- Collapse eqv expr
 6411
 6412   ffebld expr;
 6413   ffelexToken token;
 6414   expr = ffeexpr_collapse_eqv(expr,token);
 6415
 6416   If the result of the expr is a constant, replaces the expr with the
 6417   computed constant.  */
 6418
 6419ffebld
 6420ffeexpr_collapse_eqv (ffebld expr, ffelexToken t)
 6421{
 6422  ffebad error = FFEBAD;
 6423  ffebld l;
 6424  ffebld r;
 6425  ffebldConstantUnion u;
 6426  ffeinfoBasictype bt;
 6427  ffeinfoKindtype kt;
 6428
 6429  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 6430    return expr;
 6431
 6432  l = ffebld_left (expr);
 6433  r = ffebld_right (expr);
 6434
 6435  if (ffebld_op (l) != FFEBLD_opCONTER)
 6436    return expr;
 6437  if (ffebld_op (r) != FFEBLD_opCONTER)
 6438    return expr;
 6439
 6440  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 6441    {
 6442    case FFEINFO_basictypeANY:
 6443      return expr;
 6444
 6445    case FFEINFO_basictypeINTEGER:
 6446      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6447	{
 6448#if FFETARGET_okINTEGER1
 6449	case FFEINFO_kindtypeINTEGER1:
 6450	  error = ffetarget_eqv_integer1 (ffebld_cu_ptr_integer1 (u),
 6451			       ffebld_constant_integer1 (ffebld_conter (l)),
 6452			      ffebld_constant_integer1 (ffebld_conter (r)));
 6453	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 6454					(ffebld_cu_val_integer1 (u)), expr);
 6455	  break;
 6456#endif
 6457
 6458#if FFETARGET_okINTEGER2
 6459	case FFEINFO_kindtypeINTEGER2:
 6460	  error = ffetarget_eqv_integer2 (ffebld_cu_ptr_integer2 (u),
 6461			       ffebld_constant_integer2 (ffebld_conter (l)),
 6462			      ffebld_constant_integer2 (ffebld_conter (r)));
 6463	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 6464					(ffebld_cu_val_integer2 (u)), expr);
 6465	  break;
 6466#endif
 6467
 6468#if FFETARGET_okINTEGER3
 6469	case FFEINFO_kindtypeINTEGER3:
 6470	  error = ffetarget_eqv_integer3 (ffebld_cu_ptr_integer3 (u),
 6471			       ffebld_constant_integer3 (ffebld_conter (l)),
 6472			      ffebld_constant_integer3 (ffebld_conter (r)));
 6473	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 6474					(ffebld_cu_val_integer3 (u)), expr);
 6475	  break;
 6476#endif
 6477
 6478#if FFETARGET_okINTEGER4
 6479	case FFEINFO_kindtypeINTEGER4:
 6480	  error = ffetarget_eqv_integer4 (ffebld_cu_ptr_integer4 (u),
 6481			       ffebld_constant_integer4 (ffebld_conter (l)),
 6482			      ffebld_constant_integer4 (ffebld_conter (r)));
 6483	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 6484					(ffebld_cu_val_integer4 (u)), expr);
 6485	  break;
 6486#endif
 6487
 6488	default:
 6489	  assert ("bad integer kind type" == NULL);
 6490	  break;
 6491	}
 6492      break;
 6493
 6494    case FFEINFO_basictypeLOGICAL:
 6495      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6496	{
 6497#if FFETARGET_okLOGICAL1
 6498	case FFEINFO_kindtypeLOGICAL1:
 6499	  error = ffetarget_eqv_logical1 (ffebld_cu_ptr_logical1 (u),
 6500			       ffebld_constant_logical1 (ffebld_conter (l)),
 6501			      ffebld_constant_logical1 (ffebld_conter (r)));
 6502	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
 6503					(ffebld_cu_val_logical1 (u)), expr);
 6504	  break;
 6505#endif
 6506
 6507#if FFETARGET_okLOGICAL2
 6508	case FFEINFO_kindtypeLOGICAL2:
 6509	  error = ffetarget_eqv_logical2 (ffebld_cu_ptr_logical2 (u),
 6510			       ffebld_constant_logical2 (ffebld_conter (l)),
 6511			      ffebld_constant_logical2 (ffebld_conter (r)));
 6512	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
 6513					(ffebld_cu_val_logical2 (u)), expr);
 6514	  break;
 6515#endif
 6516
 6517#if FFETARGET_okLOGICAL3
 6518	case FFEINFO_kindtypeLOGICAL3:
 6519	  error = ffetarget_eqv_logical3 (ffebld_cu_ptr_logical3 (u),
 6520			       ffebld_constant_logical3 (ffebld_conter (l)),
 6521			      ffebld_constant_logical3 (ffebld_conter (r)));
 6522	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
 6523					(ffebld_cu_val_logical3 (u)), expr);
 6524	  break;
 6525#endif
 6526
 6527#if FFETARGET_okLOGICAL4
 6528	case FFEINFO_kindtypeLOGICAL4:
 6529	  error = ffetarget_eqv_logical4 (ffebld_cu_ptr_logical4 (u),
 6530			       ffebld_constant_logical4 (ffebld_conter (l)),
 6531			      ffebld_constant_logical4 (ffebld_conter (r)));
 6532	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
 6533					(ffebld_cu_val_logical4 (u)), expr);
 6534	  break;
 6535#endif
 6536
 6537	default:
 6538	  assert ("bad logical kind type" == NULL);
 6539	  break;
 6540	}
 6541      break;
 6542
 6543    default:
 6544      assert ("bad type" == NULL);
 6545      return expr;
 6546    }
 6547
 6548  ffebld_set_info (expr, ffeinfo_new
 6549		   (bt,
 6550		    kt,
 6551		    0,
 6552		    FFEINFO_kindENTITY,
 6553		    FFEINFO_whereCONSTANT,
 6554		    FFETARGET_charactersizeNONE));
 6555
 6556  if ((error != FFEBAD)
 6557      && ffebad_start (error))
 6558    {
 6559      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 6560      ffebad_finish ();
 6561    }
 6562
 6563  return expr;
 6564}
 6565
 6566/* ffeexpr_collapse_neqv -- Collapse neqv expr
 6567
 6568   ffebld expr;
 6569   ffelexToken token;
 6570   expr = ffeexpr_collapse_neqv(expr,token);
 6571
 6572   If the result of the expr is a constant, replaces the expr with the
 6573   computed constant.  */
 6574
 6575ffebld
 6576ffeexpr_collapse_neqv (ffebld expr, ffelexToken t)
 6577{
 6578  ffebad error = FFEBAD;
 6579  ffebld l;
 6580  ffebld r;
 6581  ffebldConstantUnion u;
 6582  ffeinfoBasictype bt;
 6583  ffeinfoKindtype kt;
 6584
 6585  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 6586    return expr;
 6587
 6588  l = ffebld_left (expr);
 6589  r = ffebld_right (expr);
 6590
 6591  if (ffebld_op (l) != FFEBLD_opCONTER)
 6592    return expr;
 6593  if (ffebld_op (r) != FFEBLD_opCONTER)
 6594    return expr;
 6595
 6596  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
 6597    {
 6598    case FFEINFO_basictypeANY:
 6599      return expr;
 6600
 6601    case FFEINFO_basictypeINTEGER:
 6602      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6603	{
 6604#if FFETARGET_okINTEGER1
 6605	case FFEINFO_kindtypeINTEGER1:
 6606	  error = ffetarget_neqv_integer1 (ffebld_cu_ptr_integer1 (u),
 6607			       ffebld_constant_integer1 (ffebld_conter (l)),
 6608			      ffebld_constant_integer1 (ffebld_conter (r)));
 6609	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
 6610					(ffebld_cu_val_integer1 (u)), expr);
 6611	  break;
 6612#endif
 6613
 6614#if FFETARGET_okINTEGER2
 6615	case FFEINFO_kindtypeINTEGER2:
 6616	  error = ffetarget_neqv_integer2 (ffebld_cu_ptr_integer2 (u),
 6617			       ffebld_constant_integer2 (ffebld_conter (l)),
 6618			      ffebld_constant_integer2 (ffebld_conter (r)));
 6619	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
 6620					(ffebld_cu_val_integer2 (u)), expr);
 6621	  break;
 6622#endif
 6623
 6624#if FFETARGET_okINTEGER3
 6625	case FFEINFO_kindtypeINTEGER3:
 6626	  error = ffetarget_neqv_integer3 (ffebld_cu_ptr_integer3 (u),
 6627			       ffebld_constant_integer3 (ffebld_conter (l)),
 6628			      ffebld_constant_integer3 (ffebld_conter (r)));
 6629	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
 6630					(ffebld_cu_val_integer3 (u)), expr);
 6631	  break;
 6632#endif
 6633
 6634#if FFETARGET_okINTEGER4
 6635	case FFEINFO_kindtypeINTEGER4:
 6636	  error = ffetarget_neqv_integer4 (ffebld_cu_ptr_integer4 (u),
 6637			       ffebld_constant_integer4 (ffebld_conter (l)),
 6638			      ffebld_constant_integer4 (ffebld_conter (r)));
 6639	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
 6640					(ffebld_cu_val_integer4 (u)), expr);
 6641	  break;
 6642#endif
 6643
 6644	default:
 6645	  assert ("bad integer kind type" == NULL);
 6646	  break;
 6647	}
 6648      break;
 6649
 6650    case FFEINFO_basictypeLOGICAL:
 6651      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
 6652	{
 6653#if FFETARGET_okLOGICAL1
 6654	case FFEINFO_kindtypeLOGICAL1:
 6655	  error = ffetarget_neqv_logical1 (ffebld_cu_ptr_logical1 (u),
 6656			       ffebld_constant_logical1 (ffebld_conter (l)),
 6657			      ffebld_constant_logical1 (ffebld_conter (r)));
 6658	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
 6659					(ffebld_cu_val_logical1 (u)), expr);
 6660	  break;
 6661#endif
 6662
 6663#if FFETARGET_okLOGICAL2
 6664	case FFEINFO_kindtypeLOGICAL2:
 6665	  error = ffetarget_neqv_logical2 (ffebld_cu_ptr_logical2 (u),
 6666			       ffebld_constant_logical2 (ffebld_conter (l)),
 6667			      ffebld_constant_logical2 (ffebld_conter (r)));
 6668	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
 6669					(ffebld_cu_val_logical2 (u)), expr);
 6670	  break;
 6671#endif
 6672
 6673#if FFETARGET_okLOGICAL3
 6674	case FFEINFO_kindtypeLOGICAL3:
 6675	  error = ffetarget_neqv_logical3 (ffebld_cu_ptr_logical3 (u),
 6676			       ffebld_constant_logical3 (ffebld_conter (l)),
 6677			      ffebld_constant_logical3 (ffebld_conter (r)));
 6678	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
 6679					(ffebld_cu_val_logical3 (u)), expr);
 6680	  break;
 6681#endif
 6682
 6683#if FFETARGET_okLOGICAL4
 6684	case FFEINFO_kindtypeLOGICAL4:
 6685	  error = ffetarget_neqv_logical4 (ffebld_cu_ptr_logical4 (u),
 6686			       ffebld_constant_logical4 (ffebld_conter (l)),
 6687			      ffebld_constant_logical4 (ffebld_conter (r)));
 6688	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
 6689					(ffebld_cu_val_logical4 (u)), expr);
 6690	  break;
 6691#endif
 6692
 6693	default:
 6694	  assert ("bad logical kind type" == NULL);
 6695	  break;
 6696	}
 6697      break;
 6698
 6699    default:
 6700      assert ("bad type" == NULL);
 6701      return expr;
 6702    }
 6703
 6704  ffebld_set_info (expr, ffeinfo_new
 6705		   (bt,
 6706		    kt,
 6707		    0,
 6708		    FFEINFO_kindENTITY,
 6709		    FFEINFO_whereCONSTANT,
 6710		    FFETARGET_charactersizeNONE));
 6711
 6712  if ((error != FFEBAD)
 6713      && ffebad_start (error))
 6714    {
 6715      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
 6716      ffebad_finish ();
 6717    }
 6718
 6719  return expr;
 6720}
 6721
 6722/* ffeexpr_collapse_symter -- Collapse symter expr
 6723
 6724   ffebld expr;
 6725   ffelexToken token;
 6726   expr = ffeexpr_collapse_symter(expr,token);
 6727
 6728   If the result of the expr is a constant, replaces the expr with the
 6729   computed constant.  */
 6730
 6731ffebld
 6732ffeexpr_collapse_symter (ffebld expr, ffelexToken t UNUSED)
 6733{
 6734  ffebld r;
 6735  ffeinfoBasictype bt;
 6736  ffeinfoKindtype kt;
 6737  ffetargetCharacterSize len;
 6738
 6739  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 6740    return expr;
 6741
 6742  if ((r = ffesymbol_init (ffebld_symter (expr))) == NULL)
 6743    return expr;		/* A PARAMETER lhs in progress. */
 6744
 6745  switch (ffebld_op (r))
 6746    {
 6747    case FFEBLD_opCONTER:
 6748      break;
 6749
 6750    case FFEBLD_opANY:
 6751      return r;
 6752
 6753    default:
 6754      return expr;
 6755    }
 6756
 6757  bt = ffeinfo_basictype (ffebld_info (r));
 6758  kt = ffeinfo_kindtype (ffebld_info (r));
 6759  len = ffebld_size (r);
 6760
 6761  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
 6762				      expr);
 6763
 6764  ffebld_set_info (expr, ffeinfo_new
 6765		   (bt,
 6766		    kt,
 6767		    0,
 6768		    FFEINFO_kindENTITY,
 6769		    FFEINFO_whereCONSTANT,
 6770		    len));
 6771
 6772  return expr;
 6773}
 6774
 6775/* ffeexpr_collapse_funcref -- Collapse funcref expr
 6776
 6777   ffebld expr;
 6778   ffelexToken token;
 6779   expr = ffeexpr_collapse_funcref(expr,token);
 6780
 6781   If the result of the expr is a constant, replaces the expr with the
 6782   computed constant.  */
 6783
 6784ffebld
 6785ffeexpr_collapse_funcref (ffebld expr, ffelexToken t UNUSED)
 6786{
 6787  return expr;			/* ~~someday go ahead and collapse these,
 6788				   though not required */
 6789}
 6790
 6791/* ffeexpr_collapse_arrayref -- Collapse arrayref expr
 6792
 6793   ffebld expr;
 6794   ffelexToken token;
 6795   expr = ffeexpr_collapse_arrayref(expr,token);
 6796
 6797   If the result of the expr is a constant, replaces the expr with the
 6798   computed constant.  */
 6799
 6800ffebld
 6801ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t UNUSED)
 6802{
 6803  return expr;
 6804}
 6805
 6806/* ffeexpr_collapse_substr -- Collapse substr expr
 6807
 6808   ffebld expr;
 6809   ffelexToken token;
 6810   expr = ffeexpr_collapse_substr(expr,token);
 6811
 6812   If the result of the expr is a constant, replaces the expr with the
 6813   computed constant.  */
 6814
 6815ffebld
 6816ffeexpr_collapse_substr (ffebld expr, ffelexToken t)
 6817{
 6818  ffebad error = FFEBAD;
 6819  ffebld l;
 6820  ffebld r;
 6821  ffebld start;
 6822  ffebld stop;
 6823  ffebldConstantUnion u;
 6824  ffeinfoKindtype kt;
 6825  ffetargetCharacterSize len;
 6826  ffetargetIntegerDefault first;
 6827  ffetargetIntegerDefault last;
 6828
 6829  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
 6830    return expr;
 6831
 6832  l = ffebld_left (expr);
 6833  r = ffebld_right (expr);	/* opITEM. */
 6834
 6835  if (ffebld_op (l) != FFEBLD_opCONTER)
 6836    return expr;
 6837
 6838  kt = ffeinfo_kindtype (ffebld_info (l));
 6839  len = ffebld_size (l);
 6840
 6841  start = ffebld_head (r);
 6842  stop = ffebld_head (ffebld_trail (r));
 6843  if (start == NULL)
 6844    first = 1;
 6845  else
 6846    {
 6847      if ((ffebld_op (start) != FFEBLD_opCONTER)
 6848	  || (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER)
 6849	  || (ffeinfo_kindtype (ffebld_info (start))
 6850	      != FFEINFO_kindtypeINTEGERDEFAULT))
 6851	return expr;
 6852      first = ffebld_constant_integerdefault (ffebld_conter (start));
 6853    }
 6854  if (stop == NULL)
 6855    last = len;
 6856  else
 6857